home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 July / Chip_2002-07_cd1.bin / zkuste / delphi / kolekce / d56 / DIMPAS.ZIP / Dim.pas next >
Pascal/Delphi Source File  |  2002-04-19  |  182KB  |  6,568 lines

  1. {*********************************************************}
  2. {* Turbo Pascal 5.0 - Borland Delphi 6.0 Runtime Library *}
  3. {* Copyright ⌐ 1992-2002 by Dimka Maslov                 *}
  4. {*  E-mail:   dms@nm.ru                                  *}
  5. {*  Web-site: http://dims.gpsm.ru                        *}
  6. {*                                                       *}
  7. {****         Licensed for free distribution          ****}
  8. {*                                                       *}
  9. {* Last Update: Apr. 19, 2002 (Release ID: 02.4)         *}
  10. {*********************************************************}
  11.  
  12. unit Dim;
  13.  
  14. interface
  15.  
  16. uses Windows, SysUtils, ActiveX, ShlObj, Classes, ShellAPI;
  17.  
  18. const
  19. // Useful constants declaration
  20.   Nul                 = 0;
  21.   MaxWord             = $FFFF;
  22.   MaxInteger          = $7FFFFFFF;
  23.   MaxFloat            = 1.7e308;
  24.   MinFloat            = 5.0e-324;
  25.   MaxExtended         = 1.1e4932;
  26.   MinExtended         = 9.99e-4933;
  27.   HalfCycle           = Pi;
  28.   FullCycle           = 2*Pi;
  29.   Quadrant            = Pi/2;
  30.  
  31.   chNull              = #0;
  32.   chBackspace         = #8;
  33.   chTab               = #9;
  34.   chShiftTab          = #15;
  35.   chEnter             = #13;
  36.   chEsc               = #27;
  37.   chSpace             = #32;
  38.   chComma             = ',';
  39.   chPoint             = '.';
  40.   chQuote             = '''';
  41.   chDoubleQuote       = '"';
  42.   chColon             = ':';
  43.   chEqual             = '=';
  44.   chMore              = '>';
  45.   chLess              = '<';
  46.   chLast              = #255;
  47.   chPlus              = '+';
  48.   chMinus             = '-';
  49.  
  50.   nTrue               = Integer(True);
  51.   nFalse              = Integer(False);
  52.   uTrue               = cardinal(True);
  53.   uFalse              = cardinal(False);
  54.   lTrue               = -1;
  55.   lFalse              = 0;
  56.  
  57. // comparison result constants
  58.   nMore               = 1;
  59.   nLess               = -1;
  60.   nEqual              = 0;
  61.  
  62. // virtual-key codes aliases;
  63.   VK_Enter            = VK_Return;
  64.   VK_Alt              = VK_Menu;
  65.   VK_PageUp           = VK_Prior;
  66.   VK_PageDown         = VK_Next;
  67.   VK_PrintScreen      = VK_SnapShot;
  68.   VK_Ctrl             = VK_Control;
  69.  
  70.   achCR               : array [0..1] of AnsiChar = #13#10;
  71.   wCR                 = $0A0D;
  72.  
  73. // html colors
  74.   clAliceBlue              = $FFF8F0;
  75.   clAntiqueWhite           = $D7EBFA;
  76.   clAqua                   = $FFFF00;
  77.   clAquamarine             = $D4FF7F;
  78.   clAzure                  = $FFFFF0;
  79.   clBeige                  = $DCF5F5;
  80.   clBisque                 = $C4E4FF;
  81.   clBlack                  = $000000;
  82.   clBlanchedAlmond         = $CDEBFF;
  83.   clBlue                   = $FF0000;
  84.   clBlueViolet             = $E22B8A;
  85.   clBrown                  = $2A2AA5;
  86.   clBurlyWood              = $87B8DE;
  87.   clCadetBlue              = $A09E5F;
  88.   clChartreuse             = $00FF7F;
  89.   clChocolate              = $1E6902;
  90.   clCoral                  = $507FFF;
  91.   clCornflowerBlue         = $ED9564;
  92.   clCornSilk               = $DCF8FF;
  93.   clCrimson                = $3C14DC;
  94.   clCyan                   = $FFFF00;
  95.   clDarkBlue               = $8B0000;
  96.   clDarkCyan               = $8B8B00;
  97.   clDarkGoldenrod          = $0B86B8;
  98.   clDarkGray               = $A9A9A9;
  99.   clDarkGreen              = $006400;
  100.   clDarkKhaki              = $6BB7BD;
  101.   clDarkMagenta            = $8B008B;
  102.   clDarkOliveGreen         = $2F6B55;
  103.   clDarkOrange             = $008CFF;
  104.   clDarkOrchid             = $CC3299;
  105.   clDarkRed                = $000088;
  106.   clDarkSalmon             = $7A96E9;
  107.   clDarkSeaGreen           = $8FBC8F;
  108.   clDarkSlateBlue          = $8B3D48;
  109.   clDarkSlateGray          = $4F4F2F;
  110.   clDarkTurquoise          = $D1CE00;
  111.   clDarkViolet             = $030094;
  112.   clDeepPink               = $9314FF;
  113.   clDeepSkyBlue            = $FFBF00;
  114.   clDimGray                = $696969;
  115.   clDodgerBlue             = $FF901E;
  116.   clFireBrick              = $2222B2;
  117.   clFloralWhite            = $F0FAFF;
  118.   clForestGreen            = $228B22;
  119.   clFuchsia                = $FF00FF;
  120.   clGhostWhite             = $FFF8F8;
  121.   clGainsboro              = $DCDCDC;
  122.   clGold                   = $00D7FF;
  123.   clGoldenrod              = $20A5DA;
  124.   clGray                   = $808080;
  125.   clGreen                  = $008000;
  126.   clGreenYellow            = $2FFFAD;
  127.   clHoneyDew               = $F0FFF0;
  128.   clHotPink                = $B469FF;
  129.   clIndianRed              = $5C5CCD;
  130.   clIndigo                 = $82004B;
  131.   clIvory                  = $F0FFFF;
  132.   clKhaki                  = $8CE6F0;
  133.   clLavender               = $FAE6E6;
  134.   clLavenderBlush          = $F5F0FF;
  135.   clLawnGreen              = $00FC7C;
  136.   clLemonChiffon           = $CDFAFF;
  137.   clLightBlue              = $E6D8AD;
  138.   clLightCoral             = $8080F0;
  139.   clLightCyan              = $FFFFE0;
  140.   clLightGoldenrodYellow   = $D2FAFA;
  141.   clLightGreen             = $90EE90;
  142.   clLightGrey              = $D3D3D3;
  143.   clLightPink              = $C1B6FF;
  144.   clLightSalmon            = $7AA0FF;
  145.   clLightSeaGreen          = $AAB220;
  146.   clLightSkyBlue           = $FACE87;
  147.   clLightSlateGray         = $998877;
  148.   clLightSteelBlue         = $DEC4B0;
  149.   clLightYellow            = $E0FFFF;
  150.   clLime                   = $00FF00;
  151.   clLimeGreen              = $32CD32;
  152.   clLinen                  = $E6F0FA;
  153.   clMagenta                = $FF00FF;
  154.   clMaroon                 = $000080;
  155.   clMediumAquamarine       = $AACD66;
  156.   clMediumBlue             = $CD0000;
  157.   clMediumOrchid           = $D355BA;
  158.   clMediumPurple           = $DB7093;
  159.   clMediumSeaGreen         = $71B33C;
  160.   clMediumSlateBlue        = $EE687B;
  161.   clMediumSpringGreen      = $9AFA00;
  162.   clMediumTurquoise        = $CCD148;
  163.   clMediumVioletRed        = $851507;
  164.   clMidnightBlue           = $701919;
  165.   clMintCream              = $FAFFF5;
  166.   clMistyRose              = $E1E4FF;
  167.   clMoccasin               = $B5E4FF;
  168.   clNavajoWhite            = $ADDEFF;
  169.   clNavy                   = $800000;
  170.   clOldLace                = $E6F5FD;
  171.   clOlive                  = $008080;
  172.   clOliveDrab              = $238E6B;
  173.   clOrange                 = $00A5FF;
  174.   clOrangered              = $0045FF;
  175.   clOrchid                 = $D670DA;
  176.   clPaleGoldenrod          = $AAE8EE;
  177.   clPaleGreen              = $98FB98;
  178.   clPaleTurquoise          = $EEEEAF;
  179.   clPaleVioletRed          = $9370DB;
  180.   clPapayaWhip             = $D5EFFF;
  181.   clPeachPuff              = $B9DAFF;
  182.   clPeru                   = $3F85CD;
  183.   clPink                   = $CBC0FF;
  184.   clPlum                   = $DDA0DD;
  185.   clPowderBlue             = $E6E0B0;
  186.   clPurple                 = $800080;
  187.   clRed                    = $0000FF;
  188.   clRosyBrown              = $8F8FBC;
  189.   clRoyalBlue              = $E16941;
  190.   clSaddleBrown            = $13458B;
  191.   clSalmon                 = $7280FA;
  192.   clSandyBrown             = $60A4F4;
  193.   clSeaGreen               = $578B2E;
  194.   clSeaShell               = $EEF5FF;
  195.   clSienna                 = $2D52A0;
  196.   clSilver                 = $C0C0C0;
  197.   clSkyBlue                = $EBCE87;
  198.   clSlateBlue              = $CD5A6A;
  199.   clSlateGray              = $908070;
  200.   clSnow                   = $FAFAFF;
  201.   clSpringGreen            = $7FFF00;
  202.   clSteelBlue              = $B48246;
  203.   clTan                    = $8CB4D2;
  204.   clTeal                   = $808000;
  205.   clThistle                = $D8BFD8;
  206.   clTomato                 = $4763FF;
  207.   clTurquoise              = $D0E040;
  208.   clViolet                 = $EE82EE;
  209.   clWheat                  = $B3DEF5;
  210.   clWhite                  = $FFFFFF;
  211.   clWhiteSmoke             = $F5F5F5;
  212.   clYellow                 = $00FFFF;
  213.   clYellowGreen            = $32CD9A;
  214.  
  215.   clDimGreen               = $3C8000;
  216.  
  217.  
  218. type
  219.   PString=^TString;
  220.   TString=type AnsiString;
  221.  
  222.   PAnsiStr=^TAnsiStr;
  223.   TAnsiStr=array[0..259] of AnsiChar;
  224.  
  225.   PWideStr=^TWideStr;
  226.   TWideStr=array[0..259] of WideChar;
  227.  
  228.   PShortStr=^TShortStr;
  229.   TShortStr=type ShortString;
  230.  
  231.   PSetChar=^TSetChar;
  232.   TSetChar=set of AnsiChar;
  233.  
  234.   PWideInt=^TWideInt;
  235.   TWideInt=type Int64;
  236.  
  237.   TColorChannel = (ccRed, ccGreen, ccBlue, ccAlpha);
  238.   TColorChannels = set of TColorChannel;
  239.  
  240.   PBoolean = ^Boolean;
  241.  
  242. { The Hole function prevents allocating some variables
  243.   inside CPU registers due an optimization }
  244. function Hole(var A):Integer;
  245.  
  246. { The Sync procedure prevents flickering while repainting windows.
  247.  Provided for backward compatibility.
  248.  Use TWinControl.DoubleBuffered property instead calling this procedure.
  249.  This function has no action under Windows NT }
  250. procedure Sync;
  251.  
  252. { The KeyPressed function returns True if specified as VKey key is being pressed or
  253.  False otherwise.  Use VK_xxx constants to specify required key }
  254. function KeyPressed(VKey: Integer): LongBool;
  255.  
  256. { The ScanCode function returns the scan code of a pressed or released key.
  257.  lKeyData parameters must contain the LParam parameter of received WM_KEYDOWN or
  258.  WM_KEYUP messages }
  259. function ScanCode(lKeyData: Integer): Byte;
  260.  
  261. { The RightKey function returns TRUE if received WM_KEYDOWN or WM_KEYUP messages
  262.  caused by pressing RightShift or RightControl keys, or FALSE otherwise }
  263. function RightKey(lKeyData: Integer): Boolean;
  264.  
  265. { The EmulateKey procedure posts messages to a control to emulate a keystroke.
  266.   The Wnd parameter specifies the window handle to a control.
  267.   The VKey paremeter specifies a virtual key code (see VK_xxx constants)}
  268. procedure EmulateKey(Wnd: HWND; VKey: Integer);
  269.  
  270. { The Perspective procedure calculates 2D on-picture coordinates of a point.
  271.  3D coordinates of a point must be specified as the X, Y and Z parameters.
  272.  The HEIGHT parameter specifies the altitude of "observer".
  273.  The BASIS parameter specifies the distance between "observer" and "picture".
  274.  The result values will be placed at the YP and ZP coordinates }
  275. procedure Perspective(const X, Y, Z, Height, Basis: Extended; var XP, YP: Extended);
  276.  
  277. { The Interpolate function returns value of the linear function passing through the points
  278.  (X1, Y1) and (X2, Y2) at the X coordinate }
  279. function Interpolate(const X1, Y1, X2, Y2, X: Extended): Extended;
  280.  
  281. { The Det function returns the determinant of a matrix described as
  282.  a11 a12 a13
  283.  a21 a22 a23
  284.  a31 a32 a33 }
  285. function Det(a11, a12, a13, a21, a22, a23, a31, a32, a33: Double): Double;
  286.  
  287. { The SinCos procedure places values of sine and cosine functions of the THETA angle
  288.  expressed in radians at the Sin and Cos variables respectively}
  289. procedure SinCos(Theta: Extended; var Sin, Cos: Extended);
  290.  
  291. { The Tan function returns tangent of an angle ALPHA }
  292. function Tan(Alpha: Extended): Extended;
  293.  
  294. { The GetLineEqn procedure places the equation parameters (A*y+B*z+C=0) of a line
  295.  passing through the points (Y1, Z1) and (Y2, Z2) at the A, B and C variables }
  296. procedure GetLineEqn(Y1, Z1, Y2, Z2: Extended; var A, B, C: Extended);
  297.  
  298. { The LinesIntersection functions return TRUE if specified lines have the intersection
  299.  point and places values of that point coordinates at Y and Z variables. If specified
  300.  lines are parallel these functions return FALSE.
  301.   The first of two functions described below receives equations of two lines specified
  302.  as A1*y+B1*z+C1=0 and A2*y+B2*z+C2=0. The second function receives coordinates of
  303.  points (Y1, Z1) and (Y2, Z2) where the first line passing through and coordinates
  304.  of points (Y3, Z3) and (Y4, Z4) which belong to the second line }
  305. function LinesIntersection(A1, B1, C1, A2, B2, C2: Extended; var Y, Z: Extended): Boolean; overload;
  306. function LinesIntersection(Y1, Z1, Y2, Z2, Y3, Z3, Y4, Z4: Extended; var Y, Z: Extended): Boolean; overload;
  307.  
  308. { The SegmentLength function returns the lengths of a segment passing through
  309.  the (X1, Y1) and (X2, Y2) points. The value returned by this function
  310.  calculated by the Pythagorean proposition }
  311. function SegmentLength(const X1, Y1, X2, Y2: Extended): Extended;
  312.  
  313. { The Rotate procedure calculates the coordinates of the point (X, Y) in
  314.  cartesian coordinate system with the origin in the (X0, Y0) point
  315.  and turned at the Alpha angle about initial coordinate system. This procedure
  316.  places calculated values at the X1 and Y1 variables}
  317. procedure Rotate(X, Y, X0, Y0, Alpha: Extended; var X1, Y1: Extended);
  318.  
  319. {  The GetAngle function returns the clockwise angle between the up direction and
  320.   the vector sum of two vectors. The Num parameter specifies the vertical coordinate
  321.   of the end of the first vector. The Den parameter specifies the horizontal coordinate
  322.   of the end of the second vector }
  323. function GetAngle(Num, Den: Double): Double;
  324.  
  325. { The GetAlpha function returns the clockwise angle between two vectors in a right-hand
  326.  cartesian coordinate system. The Y axis of that coordinate system is directed to up
  327.  and the Z axis is directed to left.
  328.   Both of two vectors have the common origin in the point (Y2, Z2). The first vector
  329.  is directed to the point (Y1, Z1) and the second vector to the point (Y3, Z3) }
  330. function GetAlpha(Y1, Z1, Y2, Z2, Y3, Z3: Double): Double;
  331.  
  332. { The GetAlphaScr function returns the counterclockwise angle between two vectors in
  333.  a left-hand cartesian coordinate system. The X axis of yhat coodinate system is
  334.  directed to left and the Y axis is directed to bottom.
  335.   Both of two vectors have the common origin in the point (X2, Y2). The first vector
  336.  is directed to the point (X1, Y1) and the second vector to the point (X3, Y3) }
  337. function GetAlphaScr(X1, Y1, X2, Y2, X3, Y3: Double): Double;
  338.  
  339. { The RebuildRect procedure verifies that both of
  340.  coodinates in the TopLeft field in the Rect variable are less than
  341.  the corresponding coordinates in the BottomRight field, i.e. the
  342.  TopLeft field really signs at the Top Left point of a rectangle }
  343. procedure RebuildRect(var Rect: TRect);
  344.  
  345. { The MoveRect procedure adds to the fields Left and Right of the
  346.  Rect variable the value of DeltaX parameter and to the fields
  347.  Top and Bottom the value of the DeltaY }
  348. procedure MoveRect(var Rect: TRect; DeltaX, DeltaY: Integer);
  349.  
  350. { The CopyRect procedure assigns to the fields of the Dest variable
  351.  the values of the Source parameter }
  352. procedure CopyRect(const Source: TRect; var Dest: TRect);
  353.  
  354. { The DeltaRect procedure increases bounds of the Rect variable
  355.   by the value of the Delta parameter, i.e. adds the Delta
  356.   value to the Right and Bottom fields and subtracts that value
  357.   from the Left and Top fields of a rectangle }
  358. procedure DeltaRect(var Rect: TRect; Delta: Integer);
  359.  
  360. { The IsEmptyRect function returns TRUE if each field of the
  361.  Rect parameter has the zero value or FALSE otherwise }
  362. function IsEmptyRect(const Rect: TRect): LongBool;
  363.  
  364. { The RectInterscetion function calculates and returns bounds
  365.  of the rectangle that consists of the area which belongs to
  366.  both of Rect1 and Rect2 rectangles. If these rectangles have
  367.  no common area this function places zero values to each field
  368.  of its result }
  369. function RectIntersection(const Rect1, Rect2: TRect): TRect;
  370.  
  371. { The SamePoint function returns TRUE if the coordinates of the
  372.  Point1 parameter are both equally to the coordinates of the
  373.  Point2 parameter, or FALSE otherwise }
  374. function SamePoint(const Point1, Point2: TPoint): LongBool;
  375.  
  376. { The IsNullPoint function returns TRUE if both of coordinates of
  377.  the Point1 have the zero value, or FALSE otherwise }
  378. function IsNullPoint(const Point: TPoint): LongBool;
  379.  
  380. { The ComparePointX function compares the coordinates of two
  381.  points described in the Point1 and Point2 parameters. The
  382.  X coordinates of those points have the advantage during the
  383.  comparison.
  384.   The function returns:
  385.    the nLess constant value in the following cases:
  386.     1: Point1.X < Point2.X
  387.     2: (Point1.X = Point2.X) and (Point1.Y < Point2.Y);
  388.    the nMore constant value in the subsequent cases:
  389.     1: Point1.X > Point2.X
  390.     2: (Point1.X = Point2.X) and (Point2.Y > Point2.Y);
  391.    the nEqual constant value in case of each coordinate of
  392.    Point1 are equal to the corresponding cooordinates of Point2 }
  393. function ComparePointX(const Point1, Point2: TPoint): Integer;
  394.  
  395. { The ComparePointY function compares the coordinates of two
  396.  points described in the Point1 and Point2 parameters. The
  397.  Y coordinates of those points have the advantage during the
  398.  comparison.
  399.   The function returns:
  400.    the nLess constant value in the following cases:
  401.     1: Point1.Y < Point2.Y
  402.     2: (Point1.Y = Point2.Y) and (Point1.X < Point2.X);
  403.    the nMore constant value in the subsequent cases:
  404.     1: Point1.Y > Point2.Y
  405.     2: (Point1.Y = Point2.Y) and (Point2.X > Point2.X);
  406.    the nEqual constant value in case of each coordinate of
  407.    Point1 are equal to the corresponding cooordinates of Point2 }
  408. function ComparePointY(const Point1, Point2: TPoint): Integer;
  409.  
  410. { The MovePoint procedure adds the values of the DispX and DispY parameters
  411.  respectively to the X and Y fields of the Point variable }
  412. procedure MovePoint(var Point: TPoint; DispX, DispY: Integer);
  413.  
  414. { The CloseTo function returns TRUE if the coordinates of the Point2 differ
  415.   from the corresponding coordinates of the Point1 on no more than the Distance
  416.   parameter, or FALSE otherwise }
  417. function CloseTo(const Point1, Point2: TPoint; Distance: Integer): LongBool;
  418.  
  419. { The CenterPoint function returns the coordinates of the central point of a rectangle}
  420. function CenterPoint(const Rect: TRect): TPoint;
  421.  
  422. { The Max function has several overloaded versions. Each of these function returns
  423.  the greater value of the two parameters but receives parameters of different types}
  424. function Max(const R1, R2: Integer): Integer; overload;
  425. function Max(const R1, R2: Extended):Extended; overload;
  426.  
  427. { Unlike two functions Max this overloaded version receives additional optional
  428.  parameter that specifies the function to compare coordinates of two points.
  429.   If the CompareY parameter is FALSE (default value) comparison use ComparePointX
  430.  function or ComparePointY function otherwise }
  431. function Max(const P1, P2: TPoint; CompareY: LongBool = False): TPoint; overload;
  432.  
  433. { The Min function has several overloaded version. Each of these function returns
  434.  the smaller value of the two parameters but receives parameters of different types}
  435. function Min(const R1, R2: Integer): Integer; overload;
  436. function Min(const R1, R2: Extended):Extended; overload;
  437.  
  438. { Unlike two functions Min this overloaded version receives additional optional
  439.  parameter that specifies the function to compare coordinates of two points.
  440.   If the CompareY parameter is FALSE (default value) comparison use ComparePointX
  441.  function or ComparePointY function otherwise }
  442. function Min(const P1, P2: TPoint; CompareY: LongBool = False): TPoint; overload;
  443.  
  444. { The ArrangeMin procedure exchanges values of two parameters if the second parameter
  445.  is smaller than the first }
  446. procedure ArrangeMin(var R1, R2: Integer);
  447.  
  448. { The ArrangeMax procedure exchanges value of two parameters if the second parameter
  449.  is greater than the first}
  450. procedure ArrangeMax(var R1, R2: Integer);
  451.  
  452. { The Sign functions return -1 if the Value parameter is negative,
  453.  1 if the parameter is positive and 0 if the parameter is equal to zero}
  454. function Sign(const Value: Integer): Integer; overload;
  455. function Sign(const Value: Extended): Extended; overload;
  456.  
  457. { The Swap procedures exchange values of two parameters specified as R1 and R2}
  458. procedure Swap(var R1, R2: Integer); overload;
  459. procedure Swap(var R1, R2: Extended); overload;
  460. procedure Swap(var R1, R2: Double); overload;
  461. procedure Swap(var R1, R2: TString); overload;
  462.  
  463. { The Inside functions return TRUE if the Value parameter is situated
  464.  between the values of Down and Up parameters, or FALSE otherwise }
  465. function Inside(Value, Down, Up: Integer): LongBool; overload;
  466. function Inside(Value, Down, Up: Extended): LongBool; overload;
  467.  
  468. { The Inside function (third version) returns TRUE if a point lies inside
  469.  a rectangle. The coordinates of a point are specified in the Point parameter
  470.  and a rectangle is defined in the Rect parameter }
  471. function Inside(const Point: TPoint; const Rect: TRect): LongBool; overload;
  472.  
  473. { The Center function returns the coordinate where it is needed to place the origin of a
  474.  line segment to superpose its center with the center of another line segment.
  475.   The Value parameter specifies the length of the first line segment.
  476.   The HiValue parameter specifies the finish coordinate of the second segment.
  477.   The LoValue optional parameter specifies the origin coordinate of the second segment }
  478. function Center(Value: Integer; HiValue: Integer; LoValue: Integer = 0): Integer;
  479.  
  480. { The IncPtr function returns the pointer that is greater than the initial pointer P
  481.   by the Delta value }
  482. function IncPtr(P: Pointer; Delta: Integer = 1): Pointer;
  483.  
  484. { The DecPtr function returns the pointer that is smaller than the initial pointer P
  485.   by the Delta value }
  486. function DecPtr(P: Pointer; Delta: Integer = 1): Pointer;
  487.  
  488. { The Join function places the LoWord value at the low-order word of a 32-bit integer
  489.  number and the HiWord value at the high-order word of that number }
  490. function Join(const LoWord, HiWord: Word): Integer; overload;
  491.  
  492. { The SetValue procedure places the integer Value at specified address if the P parameter
  493.  is not nil }
  494. procedure SetValue(P: Pointer; Value: Integer);
  495.  
  496. { The SetIntValue procedure has the same action as the previous procedure }
  497. procedure SetIntValue(P: Pointer; Value: Integer);
  498.  
  499. { The SetWordValue procedure places the word (16-bit) Value at specified address if
  500.  the P parameter is not nil }
  501. procedure SetWordValue(P: Pointer; Value: Word);
  502.  
  503. { The SetByteValue procedure places the byte (8-bit) Value at specified address if
  504.  the P parameter is not nil }
  505. procedure SetByteValue(P: Pointer; Value: Byte);
  506.  
  507. { The DecInt procedure decreases the N variable by the Delta parameter in case
  508.  of N is not smaller or equal to the Lowest parameter }
  509. procedure DecInt(var N: Integer; Delta: Integer = 1; Lowest: Integer = 0);
  510.  
  511. { The IncInt procedure increases the N variable by the Delta parameter in case
  512.  of N is not greater or equal to the Highest parameter }
  513. procedure IncInt(var N: Integer; Delta: Integer = 1; Highest: Integer = MaxInt);
  514.  
  515. { The RoundPrev function returns the greatest multiple of Divider that is
  516.  smaller or equal than Value }
  517. function RoundPrev(Value, Divider: Integer): Integer;
  518.  
  519. { The RoundNext function returns the smallest multiple of Divider that is
  520.  greater than Value }
  521. function RoundNext(Value, Divider: Integer): Integer;
  522.  
  523. { The BoolToSign function returns 1 if B is FALSE or -1 if B is TRUE }
  524. function BoolToSign(B: LongBool): Integer;
  525.  
  526. { The Among function returns TRUE if the N parameter is equal to
  527.  one of Value array elements }
  528. function Among(N: Integer; const Values: array of Integer): LongBool;
  529.  
  530. { The Incr function increases the N value by one and returns the value
  531.  assigned to the N variable }
  532. function Incr(var N: Integer): Integer;
  533.  
  534. { The Decr function decreaeses the N value by one adn returns the value
  535.  assigned to the N variable }
  536. function Decr(var N: Integer): Integer;
  537.  
  538. { The HiLong function returns the highest long word of the N parameter
  539.  of TWideInt (Int64) type }
  540. function HiLong(const N: TWideInt): LongInt;
  541.  
  542. { The LoLong function returns the lowest long word of the N parameter
  543.  of TWideInt (Int64) type }
  544. function LoLong(const N: TWideInt): LongInt;
  545.  
  546. { The HiWord function returns the highest word of the integer N parameter}
  547. function HiWord(N: Integer): word;
  548.  
  549. { The LoWord function returns the lowest word of the integer N parameter}
  550. function LoWord(N: Integer): word;
  551.  
  552. { The HiByte function returns the highest byte of the word N parameter}
  553. function HiByte(W: Word): Byte;
  554.  
  555. { The LoByte function returns the lowest byte of the word N parameter}
  556. function LoByte(W: Word): Byte;
  557.  
  558. { The AbsSub function return the absolute value of the difference between
  559.   values of the N1 and N2 parameters}
  560. function AbsSub(N1, N2: Integer): Integer;
  561.  
  562. { The Bit function returns True in case of the Value parameter bit with number defined as
  563.  Index parameter is 1, or FALSE otherwise }
  564. function Bit(Value, Index: Integer): Boolean;
  565.  
  566. { The SwapWords function exchanges high order word with the low order
  567.   word of a 32-bit integer value}
  568. function SwapWords(Value: Integer): Integer;
  569.  
  570. { The AbsInt function returns the absolute value of an integer}
  571. function AbsInt(Value: Integer): Integer;
  572.  
  573. { The FmtString function returns a formatted string based on a template string
  574.   specified as the Str parameter and an open array of TString specified as the
  575.   Value parameter. A template string should contain several occurences of
  576.    %1, %2 etc. Each occurence of %n would be replaced with the corresponding item
  577.    of the Values array }
  578. function FmtString(const Str: TString; const Values: array of TString): TString;
  579.  
  580. { The FindChars function searches a character from the Chars set inside a Source
  581.   string. The CurrentPosition parameter specifies the originating position to search
  582.   a character and the Direction parameter specifies the search direction. If Direction
  583.   is less than zero, the function searches toward the first char, or toward the end of
  584.   a string otherwise. This function returns the index of a found character }
  585. function FindChars(const Source: TString; const Chars: TSetChar;
  586.                    CurrentPosition: Integer = 1; Direction: Integer = 1): Integer;
  587.  
  588. { The FindLastChar function returns the position of the last occurence of a character
  589.   Ch in a string S }
  590. function FindLastChar(const S: TString; Ch: Char = chSpace): Integer;
  591.  
  592. { The LeftTrim function trims all characters from the first char of a string
  593.   Str until the first character that is not equal to a character Chr}
  594. function LeftTrim(const Str: TString; const Chr: Char = chSpace): TString; overload;
  595.  
  596. { The LeftTrim function trims all characters from the first char of a string
  597.   Str until the first character that is not an item of Chrs char set}
  598. function LeftTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  599.  
  600. { The RightTrim function trims all characters from the end of a string Str
  601.   until the last character that is not equal to a character Chr}
  602. function RightTrim(const Str: TString; const Chr: Char = chSpace): TString; overload;
  603.  
  604. { The RightTrim function trims all characters from the end of a string Str
  605.    until the last character that is not an item of Chrs char set}
  606. function RightTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  607.  
  608. { The LeftExpand function places Count characters Chr into the origin of
  609.   a string Str}
  610. function LeftExpand(const Str:TString; Count: Integer;
  611.                     const Chr: Char = chSpace): TString;
  612. { The RightExpand function places Count characters Chr into the end of
  613.   a string Str}
  614. function RightExpand(const Str:TString; Count: Integer;
  615.                      const Chr: Char = chSpace): TString;
  616.  
  617. { The TrimStr function trims all characters that is equal to a character
  618.   Chr from both ends of a string Str }
  619. function TrimStr(const Str: TString; const Chr: Char = chSpace): TString;
  620.  
  621. { The LeadTrim function trims Count characters from a string Str origin }
  622. function LeadTrim(const Str: TString; Count: Integer = 1): TString;
  623.  
  624. { The TrailTrim function trims Count characters form a string Str end }
  625. function TrailTrim(const Str: TString; Count: Integer = 1): TString;
  626.  
  627. { The GetSubStr function returns the substring that is
  628.   delimited by N-1 and N occurences of the Separator character in
  629.   a string Str }
  630. function GetSubStr(const Str: TString; N: Byte; Separator: Char = chSpace): TString;
  631.  
  632. { The ExtractStr function returns the substring that is delimited by
  633.   N-1 and N occurences of several space characters}
  634. function ExtractStr(const Str: TString; N : Byte): TString;
  635.  
  636. { The ExtractStrings procedure places into a List all substrings those are delimited
  637.   by occurences of the Separator character }
  638. procedure ExtractStrings(Str: TString; List: TStrings; Separator: Char = chSpace);
  639.  
  640. { The RemoveChars function removes all characters that belongs to a Chars set from
  641.   a string Str }
  642. function RemoveChars(const Str: TString; const Chars: TSetChar = [chSpace]): TString;
  643.  
  644. { The ReplaceChar function replaces all characters OldChar with a NewChar in
  645.   a string Str }
  646. function ReplaceChar(const Str: TString; OldChar, NewChar: Char): TString;
  647.  
  648.  
  649. { The ReplaceStr function replaces the first occurence of a substring OldSubStr with
  650.   a NewSubStr in a string Str }
  651. function ReplaceStr(const Str: TString; const OldSubStr, NewSubStr: TString): TString;
  652.  
  653.  
  654. { The ReplaceStrAll function replaces all occurences of a substring OldSubStr with
  655.  a NewSubStr in a string Str }
  656. function ReplaceStrAll(const Str: TString; const OldSubStr, NewSubStr: TString): TString;
  657.  
  658.  
  659. { The CleanUp procedure trims all the characters behind the first zero character in a
  660.   string Str }
  661. procedure CleanUp(var Str: TString); overload;
  662.  
  663. { The CleanUp procedure trims all the characters behind the first zero character in
  664.   a string Str and deletes all the space characters from the both ends of the
  665.   resulting string if the DoTrim parameters is True}
  666. procedure CleanUp(var Str: TString; DoTrim: LongBool);overload;
  667.  
  668. { The FillString function makes a string that consist of Count characters Chr }
  669. function FillString(Chr: Char; Count: Integer): TString;
  670.  
  671. { The UpString function converts all the characters of a string Str to uppercase}
  672. function UpString(const Str: TString): TString;
  673.  
  674. { The DnString function converts all the characters of a string Str to small letters}
  675. function DnString(const Str: TString): TString;
  676.  
  677. { The UpChar function converts a character to uppercase}
  678. function UpChar(Ch: Char): Char;
  679.  
  680. { The DnChar function converts a character to small letter}
  681. function DnChar(Ch: Char): Char;
  682.  
  683. { The GetChar function returns the character with Position index from a string
  684.   Str. Unlike Str[Position] call this function verifies that a string is not
  685.   empty and raises no exception}
  686. function GetChar(const Str:TString; Position: Integer = 1): Char;
  687.  
  688. { The ReadChar function returns the character that is placed in the process
  689.   memory at Offset bytes from a pointer Ptr }
  690. function ReadChar(Ptr: Pointer; Offset: Integer): Char;
  691.  
  692. { The ReflectStr function returns a 'mirror reflection' of a specified string}
  693. function ReflectStr(const Str: TString): TString;
  694.  
  695. { The ReadSubStr function returns the substring from a string Str that
  696.   is placed between characters with indices Head and Tail}
  697. function ReadSubStr(const Str: TString; Head, Tail: Integer): TString;
  698.  
  699. { The StrToFlt function converts a string Str to a number calling the Val procedure.
  700.   This function places to the Code variable the index of the first offending
  701.   character if it is unable to covert string, or 0 otherwise. The decimal separator
  702.   in a string must always be the dot sign }
  703. function StrToFlt(const Str: TString; var Code: Integer): Extended; overload;
  704.  
  705. { The StrToFlt function converts a string Str to a number with no error finding. The
  706.   decimal separator in a string must always be the dot sign }
  707. function StrToFlt(const Str: TString): Extended; overload;
  708.  
  709. { The FltToStr function converts a Value number into a string. The Precision
  710.   parameter specifies the number of significant decimal digits in the resulting
  711.   string. This function always use the dot character as a decimal separator }
  712. function FltToStr(const Value: Extended; Precision: Integer = 5): TString;
  713.  
  714. { The ValidInt function verifies that a string Value may be converted to an
  715.   integer number }
  716. function ValidInt(const Value: TString): LongBool;
  717.  
  718. { The ValidFloat function verifies that a string Value may be converted to
  719.   a double real number }
  720. function ValidFloat(const Value: TString): LongBool;
  721.  
  722. { The ValidFloatINF function verifies that a string Value may be converted to
  723.  a double real number and resulting number does not exceed the range of that type}
  724. function ValidFloatINF(const Value: TString): LongBool;
  725.  
  726. { The ValidateFloat function changes the regional decimal separator to the
  727.   dot sign in a string Value. This function returns the resulting string that
  728.   may be converted to a double real value or empty string if not}
  729. function ValidateFloat(const Value: TString): TString;
  730.  
  731. { The Join function concatenates two strings }
  732. function Join(const Str1, Str2: TString): TString; overload;
  733.  
  734. { The AddString procedure adds a string Value to the variable Str }
  735. procedure AddString(var Str: TString; const Value: TString);
  736.  
  737. { The BreakStr function breaks a string Str (inserting CR-LF pairs) to several lines.
  738.   Each line has only whole words and no more than Len value length. Each word in a
  739.   line is delimited by space signs. If a word in a line has too many characters, the
  740.   AltChar character would be used to delimit words }
  741. function BreakStr(const Str: TString; Len:Integer = 64; AltChar: Char = '\'): TString;
  742.  
  743. { The LastChar function returns the last char of a string Str }
  744. function LastChar(const Str: TString): Char;
  745.  
  746. { The NextChar function returns the character of a string Str, that stands
  747.   after position specifed as Pos and is not equal to a character Passed }
  748. function NextChar(const Str: TString; Pos: Integer;
  749.                   Passed: Char = chSpace): Char; overload;
  750.  
  751. { The PrevChar function returns the character of a string Str, that stands
  752.   before position specified as Pos and is not equal to a character Passed }
  753. function PrevChar(const Str: TString; Pos: Integer;
  754.                   Passed: Char = chSpace): Char; overload;
  755.  
  756. { The NextChar function returns the character of a string Str, that stands
  757.   after position specified as Pos and is not equal to a character that
  758.   belongs to a set Passed }
  759. function NextChar(const Str: TString; Pos: Integer; Passed: TSetChar): Char; overload;
  760.  
  761. { The PrevChar function returns the character of a string Str, that stands
  762.   before position specified as Pos and is not equal to a character that
  763.   belongs to a set Passed }
  764. function PrevChar(const Str: TString; Pos: Integer; Passed: TSetChar): Char; overload;
  765.  
  766. { The AdjustLength function verifies that a string Str is not less than Len
  767.   characters long.  This function fills the deficiency of characters inserting
  768.   several characters Chr before the string first character }
  769. function AdjustLength(Str: TString; Len: Integer; Ch: Char = chSpace): TString;
  770.  
  771. { The CharCount function returns the count of characters Ch in a string Str }
  772. function CharCount(const Str: TString; Ch: Char): Integer;
  773.  
  774. { The CopyToBuf procedure copies a string Source to a buffer Buf. The Size
  775.   parameter specifies the length of a buffer. If s string length exceeds Size
  776.   this function writes a null character to a buffer and returns False, otherwise
  777.   this function copies a string and returns True}
  778. function CopyToBuf(const Source: TString; Buf: PChar; Size: Integer): LongBool;
  779.  
  780.  
  781. { The MatchString function compares a string Str with items of an array Values.
  782.   This function returns the index of the array item that is equal to Str or zero
  783.   if there is no equal items. The optional CaseSensitive parameter specifies the
  784.   comparison style }
  785. function MatchString(const Str: TString; const Values: array of TString;
  786.                             CaseSensitive: LongBool = False): Integer;
  787.  
  788. { The MatchStringEx function works like the MatchString function but receives
  789.   an array as the address of the first array item (Values parameter) and the
  790.   count of array items (Count parameter) }
  791. function MatchStringEx(const Str: TString; const Values: Pointer; Count: Integer;
  792.                             CaseSensitive: LongBool = False): Integer;
  793.  
  794. { The GetLength function returns the length between the first character in
  795.   a string Str and then first null character}
  796. function GetLength(const Str: TString): Integer;
  797.  
  798. { The GetStrLen function returns assigned length of a string Str. This function
  799.   works like the standard Length function }
  800. function GetStrLen(const Str: TString): Integer;
  801.  
  802. { The IsEmptyStr function returns True if a string Str is empty or False otherwise}
  803. function IsEmptyStr(const Str: TString): LongBool;
  804.  
  805. { The CharEntryPos function returns the position of an occurence of
  806.   a character Ch in a string Str. The Entry parameter specifies the
  807.   number of occurence }
  808. function CharEntryPos(const Str: TString; Ch: Char; Entry: Integer): Integer;
  809.  
  810. { The ReplaceText procedure removes a substring of Len characters long
  811.   starting the Pos position and inserts the SubStr there }
  812. procedure ReplaceText(const SubStr:TString;var Str: TString; Pos, Len: Integer);
  813.  
  814. { The EqualText function compares two strings without case sensitivity }
  815. function EqualText(const S1, S2: TString): LongBool;
  816.  
  817. { The EqualStr function compares two strings with case sensitivity }
  818. function EqualStr(const S1, S2: TString): LongBool;
  819.  
  820. { The IntToStrLen function converts an integer N to a string and verifies
  821.   that resulting string is not not less than Len characters long.
  822.   This function fills the deficiency of characters inserting
  823.   several '0' characters  before the result first character }
  824. function IntToStrLen(N: Integer; Len: Integer = 0): TString;
  825.  
  826.  
  827. { The GetPos function returns the index value of the first character in a specified
  828.  substring that occurs in a given string. The optional CaseSencitive parameter
  829.  specifies the substring seacrhing style }
  830. function GetPos(const SubStr, Str: TString; CaseSensitive: LongBool = True): Integer;
  831.  
  832.  
  833. { The HexToInt function converts a string with hexadecimal digits to an integer.
  834.   This function places to the Code variable the index of the first offending
  835.   character if it is unable to covert string, or 0 otherwise }
  836. function HexToInt(const Hex: TString; var Code: Integer): Integer;
  837.  
  838. { The UniteLists procedure adds to List1 all the items of List2 those are not
  839.   equal to each item of List1}
  840. procedure UniteLists(List1, List2: TStrings);
  841.  
  842. function Year: Word;         // returns the current year
  843. function Month: Word;        // returns the current month
  844. function Day: Word;          // returns the current day
  845. function DayOfWeek: Word;    // returns the current day of the week;
  846.                              // Sunday = 0, Monday = 1, etc.
  847. function Hour: Word;         // returns the current hour
  848. function Minute: Word;       // returns the current minute
  849. function Second: Word;       // returns the current second
  850. function Milliseconds: Word; // returns the current milliseonds
  851. function Timer: Integer;     // returns the count of milliseconds passed since the last midnight
  852. function LeapYear(Year: Word): Boolean; // returns TRUE if a specified Year is leap
  853.                                         // or FALSE otherwise
  854.  
  855. function MonthLength(Month, Year: Word): Word; overload;// returns length of a Month of a Year
  856.                                                // using the Gregorian calendar
  857. function MonthLength: Word;  overload;// returns the length of a current Month
  858.  
  859.  
  860. { The GUIDToString function converts a GUID to a string }
  861. function GUIDToString(const GUID: TGUID): TString;
  862.  
  863. { The CreateGUID function creates a new GUID }
  864. function CreateGUID(out GUID: TGUID): HResult; stdcall;
  865.  
  866. { The GetLogicalDriveList procedure fills a string list specified in the List parameter
  867.   with names of all the logical drives on a computer }
  868. procedure GetLogicalDriveList(const List: TStrings);
  869.  
  870. { The GetFixedDriveList procedure fills a string list specified in the List parameter
  871.   with names of all the fixed (not removable, remote etc) drives on a computer}
  872. procedure GetFixedDriveList(const List: TStrings);
  873.  
  874.  
  875. { The ChangeLayout function changes the active keyboard layout. The LANG parameters
  876.   should be one of the LANG_xxxx constants, LANG_ENGLISH or LANG_RUSSIAN for
  877.   example. This function returns True if a desired language layout found and
  878.   activated, or False otherwise}
  879. function ChangeLayout(LANG: Integer): Boolean;
  880.  
  881. { The GetStringFileInfo function returns specified version information about a file.
  882.   The FileName parameter specifies the name of the file of interest.
  883.   The Key parameter specifies the name of a string version values. This parameter
  884.   must be one of the sfiXXXX constants described below}
  885. function GetStringFileInfo(const FileName: TString; const Key: TString): TString;
  886. const
  887.   sfiCompanyName       = 'CompanyName';
  888.   sfiFileDescription   = 'FileDescription';
  889.   sfiFileVersion       = 'FileVersion';
  890.   sfiInternalName      = 'InternalName';
  891.   sfiLegalCopyright    = 'LegalCopyright';
  892.   sfiLegalTrademark    = 'LegalTrademark';
  893.   sfiOriginalFileName  = 'OriginalFilename';
  894.   sfiProductName       = 'ProductName';
  895.   sfiProductVersion    = 'ProductVersion';
  896.   sfiComments          = 'Comments';
  897.   sfiPrivateBuild      = 'PrivateBuild';
  898.   sfiSpecialBuild      = 'SpecialBuild';
  899.   sfiLanguageName      = 'Language';
  900.   sfiLanguageID        = 'LanguageID';
  901.  
  902. { The LoadFile procedure copies data from a file into memory.
  903.   The FileName parameter specifies the name of a file to load.
  904.   This procedure returns address of the allocated memory in the Buffer variable,
  905.   and size of the memory in the Size variable. The allocated memory should be freed
  906.   exceptionally using the DeallocateMem function}
  907. procedure LoadFile(const FileName: TString; out Buffer: Pointer; out Size: Integer);
  908.  
  909. { The SaveFile procedure copies data form memory into a file.
  910.    The FileName parameter specifies the name of a file to save.
  911.    The Buffer parameter specifies address of the memory buffer.
  912.    The Size parameter specifies the size of the memory buffer in bytes}
  913. procedure SaveFile(const FileName: TString; Buffer: Pointer; Size: Integer);
  914.  
  915. { The GetShortName function returns the short path form
  916.   of a specified FileName parameter.}
  917. function GetShortName(const FileName: TString): TString;
  918.  
  919. { The GetLongName function converts the specified FileName to its long form.
  920.   If no long path is found, this function simply returns the specified name.}
  921. function GetLongName(const FileName: TString): TString;
  922.  
  923. { The GetUserName function returns the current user name}
  924. function GetUserName: TString;
  925.  
  926. { The GetComputerName function returns the system computer name}
  927. function GetComputerName: TString;
  928.  
  929. { The PathExists function returns TRUE if a directory specified by
  930.  Path parameter exists, or FALSE otherwise}
  931. function PathExists(const Path: TString): Boolean;
  932.  
  933. { The ExtractFolderName function returns the name of a folder
  934.   where a file specified by FileName parameter is located.}
  935. function ExtractFolderName(const FileName: TString): TString;
  936.  
  937. { The ChangeFileExt function returns the FileName parameter with
  938.   extension changes to the value of the NewExt parameter}
  939. function ChangeFileExt(const FileName, NewExt: TString): TString;
  940.  
  941. { The ForceDirectories function creates all the directories along a directory
  942.  path if they do not already exist. }
  943. function ForceDirectories(Dir: TString): Boolean;
  944.  
  945. { The GetDiskFreeSize function returns the total amount of free space
  946.   for a disk specified by its root directory }
  947. function GetDiskFreeSize(Dir: TString): Int64;
  948.  
  949. { The GetFileName function returns the name (without path and extension)
  950.  of a file specified by FileName parameter}
  951. function GetFileName(const FileName: TString): TString;
  952.  
  953. { The LoadTextFile function loads entire text from a file specified by
  954.   FileName parameter and places it to the Text variable. This function
  955.   returns error code (the value returned by IOResult function
  956.   after loading process completed) }
  957. function LoadTextFile(const FileName: TString; var Text: TString): Integer;
  958.  
  959. { The SaveTextFile function saves entire Text to a file specified by
  960.   FileName parameter. This function returns error code (the value
  961.   returned by IOResult function after saving process completed) }
  962. function SaveTextFile(const FileName, Text: TString): Integer;
  963.  
  964. { The LoadResStr functions return the value of a string resource
  965.   specified by the ID parameters. The First of two functions
  966.   loads resources from a module specified by the Instance parameter.
  967.   The second function loads resources from the current module (using
  968.   the global hInstance variable}
  969. function LoadResStr(Instance: THandle; ID: Cardinal): TString; overload;
  970. function LoadResStr(ID: Cardinal): TString; overload;
  971.  
  972. { The GetTempDirectory function returns the path of the directory
  973.   designated for temporary files.}
  974. function GetTempDirectory: TString;
  975.  
  976. { The GetTempFile function creates the name and the path of a temporary file.
  977.   The initial three chars of the Prefix parametes specify prefix for the filename}
  978. function GetTempFile(const Prefix: TString): TString;
  979.  
  980. { The Parameters function returns the command line parameters passed to
  981.   the current application }
  982. function Parameters: TString;
  983.  
  984. { The CheckAutomation function returns TRUE if an application is launched
  985.   as an automation server, or FALSE otherwise }
  986. function CheckAutomation: Boolean;
  987.  
  988. { The ExeName function returns the file name of the current application }
  989. function ExeName: TString;
  990.  
  991. { The ExePath function returns the path to the current application }
  992. function ExePath: TString;
  993.  
  994. { The InstanceName function returns the file name of the current module (EXE or DLL)}
  995. function InstanceName: TString;
  996.  
  997. { The InstancePath function returns the path to the current module (EXE or DLL)}
  998. function InstancePath: TString;
  999.  
  1000. { The ExeVersion function returns the version of the current application}
  1001. function ExeVersion: TString;
  1002.  
  1003. { The IsDebug function returns TRUE if an executable file specified
  1004.  by the FileName perameter exists and has the Debug Build flag
  1005.  selected in project options or FALSE otherwise }
  1006. function IsDebug(const FileName:  TString): LongBool; overload;
  1007.  
  1008. { The IsDebug function returns TRUE if an application has the Debug Build
  1009.  flag specified in project options or FALSE otherwise }
  1010. function IsDebug: LongBool; overload;
  1011.  
  1012. { The GetWindowSize procedure calculated size of a window specified
  1013.   by its handle and places result at the Size variable }
  1014. procedure GetWindowSize(Handle: HWND; var Size: TSize);
  1015.  
  1016. { The GetWindowCenter procedure places values of the center of a window
  1017.  specified by its Handle at addresses specified by CenterX and CenterY
  1018.  parameters. If an address is NIL this function does not place corresponding
  1019.  value }
  1020. procedure GetWindowCenter(Handle: HWND; CenterX, CenterY: PInteger);
  1021.  
  1022. { The PressKey procedure emulates a keystroke specified
  1023.  by the VKey parameter that must contain value of a VK_xxx constant}
  1024. procedure PressKey(VKey: Byte);
  1025.  
  1026. { The GetAddress function returns a pointer to a place in program code
  1027.   where from this function has been called }
  1028. function GetAddress: Pointer;
  1029.  
  1030. type // File version record type
  1031.   PFileVersion = ^TFileVersion;
  1032.   TFileVersion = record
  1033.     HiVersion : Integer; // Major version number
  1034.     LoVersion : Integer; // Minor version number
  1035.     Release   : Integer;
  1036.     Build     : Integer;
  1037.   end;
  1038.  
  1039. { The FileVersion function returns the version of an executable file
  1040.  specified by the FileName parameter }
  1041. function FileVersion(const FileName: TString = ''): TFileVersion;
  1042.  
  1043. { The StringToVersion function converts a string with HiVersion.LoVersion.Release.Build
  1044.   format to a structure of TFileVersion record }
  1045. function StringToVersion(const Str: TString): TFileVersion;
  1046.  
  1047. { The VersionToString function converts a structure of TFileVersion
  1048.  record to a string with HiVersion.LoVersion.Release.Build format. }
  1049. function VersionToString(const Ver: TFileVersion): TString;
  1050.  
  1051. { The Version function creates a structure of TFileVersion record
  1052.   using corresponding parameters}
  1053. function Version(HiVersion, LoVersion: Integer;
  1054.   Release: Integer = 0; Build: Integer = 0): TFileVersion;
  1055.  
  1056. { The CompareVersion function compares two parameters of the TFileVersion type.
  1057.   This function returns following values:
  1058.    nLess  : Version1 is older than Version2
  1059.    nEqual : Version1 is equal to Version2
  1060.    nMore  : Version1 is later than Version2 }
  1061. function CompareVersion(const Version1, Version2: TFileVersion): Integer;
  1062.  
  1063. { The ComCtlVersion function returns the version of
  1064.  the COMCTL32.DLL currently used in a system }
  1065. function ComCtlVersion: TFileVersion;
  1066.  
  1067. { The LoadDLL function calls the LoadLibrary API function }
  1068. function LoadDLL(const Path: TString):THandle;
  1069.  
  1070. { The GetDLLProc function calls the GetProcAddress API function }
  1071. function GetDLLProc(Handle: THandle; const ProcName: TString):Pointer;
  1072.  
  1073. { The WinNT function returns TRUE if a program runs under Windows NT or
  1074.   FALSE otherwise. }
  1075. function WinNT: Boolean;
  1076.  
  1077. { The Win2K function returns TRUE if a program runs under Windows 2000 or
  1078.   FALSE otherwise. }
  1079. function Win2K: Boolean;
  1080.  
  1081. { The WinME function returns TRUE if a program runs under Windows Millenium Edition or
  1082.   FALSE otherwise. }
  1083. function WinME: Boolean;
  1084.  
  1085. { The WinXP function returns TRUE if a program runs under Windows XP or
  1086.   FALSE otherwise. }
  1087. function WinXP: Boolean;
  1088.  
  1089. type
  1090.   TOperatingSystem = (UndefinedWindows, Windows3x, Windows95, Windows98, WindowsME,
  1091.                   WindowsNT, Windows2000, WindowsXP);
  1092.  
  1093. { The GetOperatingSystem function returns the type of the operating system
  1094.   an application runs under}
  1095. function GetOperatingSystem: TOperatingSystem;
  1096.  
  1097. { The Sound procedure plays a tone with Frequency and Duration as
  1098.   specified in corresponding parameters. }
  1099. procedure Sound(Frequency, Duration: Integer);
  1100.  
  1101. { The OpenCD procedure opens a CD-ROM door }
  1102. procedure OpenCD;
  1103.  
  1104. { The CloseCD procedure closes a CD-ROM door }
  1105. procedure CloseCD;
  1106.  
  1107. { The GetNCFontHandle function creates a system defined font specified in the NCFont
  1108.   parameter:
  1109.    popup hint font (SmCaptionFont parameter),
  1110.    form caption font (CaptionFont parameter),
  1111.    menu font (MenuFont parameter),
  1112.    message box text font (MessageFont parameter),
  1113.    status bar font (StatusFont parameter).
  1114.    This function returns a handle to the created font }
  1115. type
  1116.   TNCFont = (CaptionFont, MenuFont, MessageFont, SmCaptionFont, StatusFont);
  1117. function GetNCFontHandle(const NCFont: TNCFont):THandle;
  1118.  
  1119. { The TrayWnd function returns the handle to Shell Tray Window }
  1120. function TrayWnd: HWND;
  1121.  
  1122. { The LangIDToCharset function returns the char code page
  1123.  for specified language identifier. If the LangID parameter is
  1124.  not specified the function uses the default system language identifier.}
  1125. function LangIDToCharset(LangID: Integer = 0): Byte;
  1126.  
  1127. { The OpenShortcut function reads information about shortcut object
  1128.  from .LNK file specified by the FileName variable and places
  1129.  object name at the same variable. If FileName variable does
  1130.  not contain a .LNK file name or this file is corrupted this
  1131.  function does not change the passed variable.}
  1132. procedure OpenShortcut(var FileName: TString);
  1133.  
  1134. { The GetLocale function returns the system locale identifier}
  1135. function GetLocale: Integer;
  1136.  
  1137. { The ExitWindows function calls the ExitWindowsEx API function.
  1138.  Under NT this function enabled required privileges to shut down or reboot a system. }
  1139. function ExitWindows(uFlags: UINT): BOOL;
  1140.  
  1141. { The RemoveDirectories procedure deletes all empty folders since a folder
  1142.  specified by the Path parameter}
  1143. procedure RemoveDirectories(const Path: TString);
  1144.  
  1145. { The CreateInstance function calls the CoCreateInstance function
  1146.  to create an inproc-server object. This function calls a procedure with
  1147.  address specified by the CannotCreateInstance variable
  1148.  if CoCreateInstance function fails}
  1149. function CreateInstance(CLSID, IID: TGUID; out Instance): HResult;
  1150. type
  1151.  TCannotCreateInstanceProc = procedure (CLSID: TGUID);
  1152. var
  1153.  CannotCreateInstance : TCannotCreateInstanceProc = nil;
  1154.  
  1155. { The Recycle function removes a file specified by the Name parameter to recycle bin.
  1156.  The optional Wnd parameter specifies the handle to the dialog box owning window.
  1157.  This function returns TRUE if a file is successfully deleted or FALSE otherwise.}
  1158. function Recycle(const Name: TString; Wnd: HWND = 0): Boolean;
  1159.  
  1160. { The MapNetworkDrive function displays the Map Network Drive dialog box.
  1161.  The optional Wnd parameter specifies the handle to the dialog box owning window.
  1162.  See WNetConnectionDialog function to find information about return values}
  1163. function MapNetworkDrive(Wnd: HWND = 0): DWORD;
  1164.  
  1165. { The DisconnectNetworkDrive function displays the Disconnect Network Drive dialog box.
  1166.  The optional Wnd parameter specifies the handle to the dialog box owning window.
  1167.  See WNetDisconnectDialog function to find information about return values}
  1168. function DisconnectNetworkDrive(Wnd: HWND = 0): DWORD;
  1169.  
  1170. { The BitsPerPixel function returns the number of bits per a screen pixel }
  1171. function BitsPerPixel: Integer;
  1172.  
  1173. { The RegWriteStr function writes a string value to the system registry. This function
  1174.  receives following parameters:
  1175.   RootKey - Handle to a currently open key or one of the predefined values
  1176.             (See HKEY_XXX constants);
  1177.   Key - a string specifying the name of a registry subkey;
  1178.   Name - a string containg the name of the value to set. If a value withh this name
  1179.          is not exist, the function creates it;
  1180.   Value - a string value to store it into the registry;
  1181.  
  1182.   This function returns TRUE if a value has been successfully written, or
  1183.    FALSE otherwise}
  1184. function RegWriteStr(RootKey: HKEY; Key, Name, Value: TString): Boolean;
  1185.  
  1186. { The RegQueryStr function reads a string value from the system registry. This function
  1187.  receives following parameters:
  1188.   RootKey - Handle to a currently open key or one of the predefined values
  1189.             (See HKEY_XXX constants);
  1190.   Key - a string specifying the name of a registry subkey;
  1191.  
  1192.   Success - an optional parameter specifying the address of a boolean variable. If the
  1193.             function succeeds, the variable at specified address receives TRUE or FALSE
  1194.             otherwise.}
  1195. function RegQueryStr(RootKey: HKEY; Key, Name: TString; Success: PBoolean = nil): TString;
  1196.  
  1197. { The RunApplication function runs a specified application.
  1198.    The Path parameter specifies the full file name of an application.
  1199.    The CmdLine parameter specifies the command line parameters for an application.
  1200.    The Dir parameter specifies the working directory for an application.
  1201.    The Wait parameter specifies the need to stop program flow until an application
  1202.     terminates.
  1203.  
  1204.    This function returns zero if it is unable to run an application. If succeed,
  1205.    function returns the handle to an application process, when Wait = False, or
  1206.    1 otherwise.
  1207.  
  1208.    This function does not work with 16-bit DOS applications }
  1209. function RunApplication(Path, CmdLine, Dir: TString; Wait: Boolean = False): Cardinal;
  1210.  
  1211. { The following three constants may be used as the shorter aliases of HKEY_XXX constants}
  1212. const
  1213.  HCR = HKEY_CLASSES_ROOT;
  1214.  HCU = HKEY_CURRENT_USER;
  1215.  HLM = HKEY_LOCAL_MACHINE;
  1216.  
  1217. // for unknown reason this function is not presented in WINDOWS.PAS
  1218. function LocalHandle(pMem: pointer): HLOCAL stdcall;
  1219.  
  1220. { The AllocateMem function allocates a memory block from the heap. This function
  1221.   calculates the size of a block through the product of Count and RecSize}
  1222. function AllocateMem(Count: Integer; RecSize: Integer = 1): Pointer;
  1223.  
  1224. { The DeallocateMem procedure frees a memory block allocated by the AllocateMem
  1225.   function}
  1226. procedure DeallocateMem(var Pointer);
  1227.  
  1228. { The ReallocateMem procedure changes the size of a block allocated by
  1229.   the AllocateMem function. The new size of a block is calculated as
  1230.   in the AllocateMem function }
  1231. procedure ReallocateMem(var Pointer; Count: Integer; RecSize: Integer = 1);
  1232.  
  1233. { The MemSize function returns the size of a memory block allocated by
  1234.   the AllocateMem function}
  1235. function MemSize(P: Pointer): Integer;
  1236.  
  1237. { The MoveMem procedure copies Count bytes from Source variable into Dest.
  1238.   This function works fully like the Move function. }
  1239. procedure MoveMem(const Source; var Dest; Count: Integer);
  1240.  
  1241. { The InvertMem procedure performs the NOT boolean operation for
  1242.   each byte originating the X variable. The Size parameter specifies
  1243.   the count of bytes to perfrom operation}
  1244. procedure InvertMem(var X; Size:Integer=1);
  1245.  
  1246. { The XorMem procedure performs the XOR boolean operation for
  1247.   each byte originating the X variable. The Size parameters specifies
  1248.   the count of bytes to perform operation. The Value parameter
  1249.   specifies the second operand to the operation }
  1250. procedure XorMem(var X; Size: Integer; Value: Byte);
  1251.  
  1252. { The XorMemW procedure performs the XOR boolean operation for
  1253.   each word originating the X variable. The Size parameters specifies
  1254.   the count of words (should be 'SizeOf(V) shr 1') to perform operation.
  1255.   The Value parameter specifies the second operand to the operation }
  1256. procedure XorMemW(var X; Count: Integer; Value: Word);
  1257.  
  1258. { The XorMemL procedure performs the XOR boolean operation for
  1259.   each double word originating the X variable. The Size parameters specifies
  1260.   the count of double words (should be 'SizeOf(V) shr 2') to perform operation.
  1261.   The Value parameter specifies the second operand to the operation }
  1262. procedure XorMemL(var X; Count: Integer; Value: LongInt);
  1263.  
  1264. { The FillMem procedure assigns the byte Value to each byte originating
  1265.   the X variable. The Size parameters specifies
  1266.   the count of bytes to perform operation. The Value parameter
  1267.   specifies the second operand to the operation }
  1268. procedure FillMem(var X; Size: Integer; Value: Byte = 0);
  1269.  
  1270. { The FillMemW procedure assigns the word Value to each word originating
  1271.   the X variable. The Size parameters specifies the count of words
  1272.   should be 'SizeOf(V) shr 1') to perform operation. The Value parameter
  1273.   specifies the second operand to the operation }
  1274. procedure FillMemW(var X; Count: Integer; Value: Word = 0);
  1275.  
  1276. { The FillMemL procedure assigns the double word Value to each double
  1277.   word originating the X variable.  The Size parameters specifies
  1278.   the count of double words (should be 'SizeOf(V) shr 2') to perform operation.
  1279.   The Value parameter specifies the second operand to the operation }
  1280. procedure FillMemL(var X; Count: Integer; Value: LongInt = 0);
  1281.  
  1282. { The ClearMem procedure fills the Size bytes originating the X
  1283.   variable with Zero values}
  1284. procedure ClearMem(var X; Size: Integer);
  1285.  
  1286.  
  1287. { The GetColor function translates a system color constant (clXXXX)
  1288.   into its color value }
  1289. function GetColor(Color: Integer): Integer; overload;
  1290.  
  1291. { The GetColor value returns the color with the
  1292.   corresponding Red, Green and Blue values }
  1293. function GetColor(Red, Green, Blue: Integer): Integer; overload;
  1294.  
  1295. { The IndexToRGB procedure places the Red, Green and Blue values
  1296.   from a color}
  1297. procedure IndexToRGB(Color: Integer; R, G, B : PByte);
  1298.  
  1299. { The Line procedure draws a line in a display context specified
  1300.   with its handle (DC parameter) from point (X1, Y1) to point (X2, Y2) }
  1301. procedure Line(DC: HDC; X1, Y1, X2, Y2: Integer);
  1302.  
  1303. { The clGradientActiveCaption function returns the color of the
  1304.   second color of window captions in Win98 and Win2K }
  1305. function clGradientActiveCaption: Integer;
  1306.  
  1307. type
  1308.   PIdentMapItem=^TIdentMapItem;
  1309.   TIdentMapItem=record
  1310.     Value             : Integer;
  1311.     Name              : TString;
  1312.   end;
  1313.  
  1314. { The ValueToName function scans the Map array of TIdentMapItem to find specified
  1315.   Value and returns the corresponding Name field of the array item in which the
  1316.   Value is found, or Default otherwise. }
  1317. function ValueToName(Value: Integer; Map: array of TIdentMapItem;
  1318.                      Default: TString = ''): TString;
  1319.  
  1320. { The NameToValue function scans the Map array of TIdentMapItem to find specified
  1321.   Name and returns the corresponding Value field of the array item in which the
  1322.   name is found, or Default otherwise. }
  1323. function NameToValue(Name: TString; Map: array of TIdentMapItem;
  1324.                      Default: Integer = 0): Integer;
  1325.  
  1326. { The Arctan2 function returns the arctangent angle of a number specified
  1327.   as X/Y. The signs of X and Y parameters specify quadrant of an angle}
  1328. function Arctan2(X, Y: Extended): Extended;
  1329.  
  1330. { The Int function returns the integral part of a number specified in
  1331.   the R parameter }
  1332. function Int(R: Extended): Extended;
  1333.  
  1334. { The Frac function returns the fractional part of a number specified in
  1335.   the R parameter }
  1336. function Frac(R: Extended): Extended;
  1337.  
  1338. { The Trunc function truncates an extended number into an integer}
  1339. function Trunc(R: Extended): Integer;
  1340.  
  1341. {The Round function rounds an extended number to a nearest integer value}
  1342. function Round(R: Extended): Integer;
  1343.  
  1344. { The Floor function rounds a number toward the negative infinity}
  1345. function Floor(R: Extended): Extended;
  1346.  
  1347. { The Ceil function rounds a number toward the positive infinity}
  1348. function Ceil(R: Extended): Extended;
  1349.  
  1350. { The ClearFPUEx procedure clears the FPU exception flag }
  1351. procedure ClearFPUEx;
  1352.  
  1353. { The Infinity function checks a number for an infinity value. This function returns
  1354.   -1 when R = -INF; 1 when R = +INF; 0 when R is a valid number }
  1355. function Infinity(R: Extended): Integer;
  1356.  
  1357. { The NonAtNumber function returns True if the specified parameter is not a valid
  1358.   number and not an infinity }
  1359. function NonAtNumber(R: Extended): Boolean;
  1360.  
  1361.  
  1362. function LetterToNumber(const Letter: TString): Integer;
  1363. function NumberToLetter(Number: Integer): TString;
  1364. procedure SplitAlphanumericName(const Name: TString; var Alpha: TString;
  1365.  var Num: Integer; const AdditionalChars: TSetChar = []);
  1366.  
  1367. type
  1368.  
  1369. { The TUnknown class is an implementation of the IUnknown interface. Unlike the
  1370.   TInterfacedObject class instances, objects of this class do not destroy
  1371.   themselves after RefCount falls to zero in the _Release method }
  1372.   TUnknown = class (TObject, IUnknown)
  1373.   protected
  1374.     FRefCount: Integer;
  1375.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  1376.     function _AddRef: Integer; virtual; stdcall;
  1377.     function _Release: Integer; virtual; stdcall;
  1378.   public
  1379.     function Unknown: IUnknown; overload;
  1380.     procedure Unknown(out Obj); overload;
  1381.   end;
  1382.  
  1383.   TObjectX = TUnknown;
  1384.  
  1385. type
  1386.  
  1387. { TShellLink class encapsulates functions those work with shell link objects}
  1388.   EShellLinkError = class (Exception);
  1389.  
  1390.   TShellLink = class(TUnknown)
  1391.   private
  1392.     FResult: HRESULT;
  1393.     FShellLink: IShellLink;
  1394.     FPersistFile : IPersistFile;
  1395.     FTemp: WideString;
  1396.     FDesktopFolder: TString;
  1397.     FProgramsFolder: TString;
  1398.     FStartMenuFolder: TString;
  1399.     FStartUpFolder: TString;
  1400.     FMyDocsFolder: TString;
  1401.     function GetArguments: TString;
  1402.     function GetDescription: TString;
  1403.     function GetHotKey: word;
  1404.     function GetIconIndex: Integer;
  1405.     function GetIconLoc: TString;
  1406.     function GetPath: TString;
  1407.     function GetPIDL: PItemIDList;
  1408.     function GetShowCmd: Integer;
  1409.     function GetWorkDir: TString;
  1410.     procedure SetArguments(const Value: TString);
  1411.     procedure SetDescription(const Value: TString);
  1412.     procedure SetHotKey(const Value: word);
  1413.     procedure SetIconIndex(const Value: Integer);
  1414.     procedure SetIconLoc(const Value: TString);
  1415.     procedure SetPath(const Value: TString);
  1416.     procedure SetPIDL(const Value: PItemIDList);
  1417.     procedure SetShowCmd(const Value: Integer);
  1418.     procedure SetWorkDir(const Value: TString);
  1419.     procedure RunError(const Msg: TString; const Args: TString = '');
  1420.     function ResolveFileName(FileName: TString): PWideChar;
  1421.     function DesktopFolder: TString;
  1422.     function ProgramsFolder: TString;
  1423.     function StartMenuFolder: TString;
  1424.     function StartUpFolder: TString;
  1425.     function MyDocsFolder: TString;
  1426.   public
  1427.     property Path:TString read GetPath write SetPath;
  1428.       // path to the shell link reference object (i.e file or folder)
  1429.     property Description:TString read GetDescription write SetDescription;
  1430.       // description of a shell link object
  1431.     property WorkingDirectory:TString read GetWorkDir write SetWorkDir;
  1432.       // the working directory for the shell link reference object
  1433.     property Arguments:TString read GetArguments write SetArguments;
  1434.       // the command line arguments to launch the shell link reference object
  1435.     property IconLocation:TString read GetIconLoc write SetIconLoc;
  1436.       // the icon location path for the shell link reference object
  1437.     property IconIndex:Integer read GetIconIndex write SetIconIndex;
  1438.       // the icon index for the shell link reference object
  1439.     property HotKey:word read GetHotKey write SetHotKey;
  1440.       // the hot key to open shell link reference object in Windows Explorer
  1441.     property ShowCmd:Integer read GetShowCmd write SetShowCmd;
  1442.       // the show command (SW_SHOWNORMAL for example) to open the object
  1443.     property PIDL:PItemIDList read GetPIDL write SetPIDL;
  1444.       // the PIDL to the shell link refernce object
  1445.  
  1446.     { The LoadFromFile function reads information from a .lnk file }
  1447.     function LoadFromFile(FileName: TString): Boolean; virtual;
  1448.  
  1449.     { The SaveToFile function writes information to a .lnk file }
  1450.     function SaveToFile(FileName: TString): Boolean; virtual;
  1451.  
  1452.     (*******************************************************************
  1453.       The FileName string passed to LoadFromFile or SaveToFile functions
  1454.       may begin with a special folder alias that will be replaced with
  1455.       a special folder location. These are folder aliases:
  1456.  
  1457.         {$Desktop} - a shortcut on the Desktop is implied
  1458.         {$StartMenu} - a shortcut in the Start Menu
  1459.         {$Programs} - a shortcut in the Start Menu\Programs submenu
  1460.         {$StartUp} - a shortcut in the Start Menu\Programs\Startup submenu
  1461.         {$MyDocs} - a shortcut in the My Documents folder
  1462.  
  1463.       All these aliases are not case sensitive. For example, the following
  1464.       expression places a shortcut on the Desktop:
  1465.  
  1466.       SaveToFile('{$desktop}\MyShortcut.lnk');
  1467.  
  1468.       Note that the backslash placed after an alias is optional.
  1469.      *********************************************************************)
  1470.  
  1471.  
  1472.     { The SpecialFolder function returns location of a system folder. One
  1473.      of fidXXX constans should be used to specify system folder (see below).
  1474.      Except that, any ShlObj.CSIDL_xxx constant may used as the FolderID parameter}
  1475.     class function SpecialFolder(FolderID:Integer):TString;
  1476.  
  1477.     constructor Create;
  1478.     destructor Destroy;override;
  1479.   end;
  1480.  
  1481. const
  1482.  fidDesktop     = CSIDL_DESKTOP;
  1483.  fidFonts       = CSIDL_FONTS;
  1484.  fidNetHood     = CSIDL_NETHOOD;
  1485.  fidPersonal    = CSIDL_PERSONAL;
  1486.  fidPrograms    = CSIDL_PROGRAMS;
  1487.  fidRecent      = CSIDL_RECENT;
  1488.  fidSendTo      = CSIDL_SENDTO;
  1489.  fidStartUp     = CSIDL_STARTUP;
  1490.  fidTemplates   = CSIDL_TEMPLATES;
  1491.  
  1492. type
  1493.  
  1494. { The TDynamicArray class encapsulates the dynamic arrays support }
  1495.   TForEachFunc = function (Tag: Integer; Index: Integer; var Item): Integer; register;
  1496.   EDynArray = class (Exception);
  1497.  
  1498.   TDynamicArray = class (TObjectX)
  1499.   private
  1500.     FHandle: hLocal;
  1501.     FData: Pointer;
  1502.     FItemSize: Cardinal;
  1503.     FCount: Cardinal;
  1504.     function AllocMem(ACount: Cardinal; var Handle: hLocal): pointer;
  1505.     procedure FreeMem(var Handle: hLocal);
  1506.     procedure _SetCount(const Value: Cardinal);
  1507.     procedure DoSizeChanged;
  1508.   protected
  1509. { The GetFirstItem function returns the address of the first item of an array }
  1510.     function  GetFirstItem: Pointer;
  1511.  
  1512. { The PutItem procedure places an item to an array }
  1513.     procedure PutItem(Index: Integer; const Item);
  1514.  
  1515. { The GetItem procedure reads an item from an array }
  1516.     procedure GetItem(Index: Integer; out Item);
  1517.  
  1518. { The Error function raises an exception when an index passed to one of methods
  1519.   exceeds range of items }
  1520.     procedure Error(Index: Integer);
  1521.  
  1522. { Methods call the SizeChanged procedure when they changes the count of items }
  1523.     procedure SizeChanged; virtual;
  1524.  
  1525. { The SetCount procedure sets the count of an array items }
  1526.     procedure SetCount(const Value: Cardinal); virtual;
  1527.   public
  1528.  
  1529. { Use the Count property to set and get count of an array items }
  1530.     property Count: Cardinal read FCount write _SetCount;
  1531.  
  1532. { Use the ItemSize property to determine the size of each array items }
  1533.     property ItemSize: Cardinal read FItemSize;
  1534.  
  1535. { Use the FirstItem property to determine the address of the first array item }
  1536.     property FirstItem: Pointer read FData;
  1537.  
  1538. { The Add function includes an item to an array and returns the index of included item }
  1539.     function Add: Integer; virtual;
  1540.  
  1541. { The AddItem function includes an item to an array and assigns the item content }
  1542.     function AddItem(const Item): Integer; virtual;
  1543.  
  1544. { The Insert procedure inserts an item to an array at specified position }
  1545.     procedure Insert(Index: Integer); virtual;
  1546.  
  1547. { The InsertItem procedure inserts an item to an array at specified position
  1548.   and assigns the item content }
  1549.     procedure InsertItem(Index: Integer; const Item); virtual;
  1550.  
  1551. { The Delete procedure deletes an item at specified position }
  1552.     procedure Delete(Index: Integer); virtual;
  1553.  
  1554. { The DeleteItem procedure copies the content of an array item to the Item variable
  1555.   and deletes an item at specified position }
  1556.     procedure DeleteItem(Index: Integer; out Item); virtual;
  1557.  
  1558. { The Extend procedure adds Count items to an array }
  1559.     procedure Extend(Count: Cardinal = 1); virtual;
  1560.  
  1561. { The Trim procedure deletes Count items from the end of an array }
  1562.     procedure Trim(Count: Cardinal = 1); virtual;
  1563.  
  1564. { The Swap procedure exchanges content of two array items }
  1565.     procedure Swap(Index1, Index2: Cardinal); virtual;
  1566.  
  1567. { The ForEach function is used to perform some operation for each array item.
  1568.   The Tag parameter specified a user defined number that will be passed to a
  1569.   ForEachFunc function that does peform desired operation. This function
  1570.   continues processing until ForEachFunc function calls return zero. When a
  1571.   ForEachFunc call returns non zero this function stops processing and returns
  1572.   received value. If no ForEachFunc call returns non zero this function returns
  1573.   zero }
  1574.     function ForEach(Tag: Integer; ForEachFunc: TForEachFunc): Integer; virtual;
  1575.  
  1576. { The GetItemPtr function returns the address of an array item }
  1577.     function GetItemPtr(Index: Integer): Pointer;
  1578.  
  1579. { The Create constructor creates an array and assigns initial count of items and
  1580.   an item size }
  1581.     constructor Create(ACount, AItemSize: Cardinal);
  1582.     destructor Destroy; override;
  1583.   end;
  1584.  
  1585.   TDynamicArrayClass = class of TDynamicArray;
  1586.  
  1587. type
  1588.  
  1589.   TFileStatus = (fsReading, fsWriting);
  1590.  
  1591.   EFileError = class (Exception);
  1592.  
  1593. const
  1594.   faReadOnly             = $00000001;
  1595.   faHidden               = $00000002;
  1596.   faSystem               = $00000004;
  1597.   faDirectory            = $00000010;
  1598.   faArchive              = $00000020;
  1599.   faEncrypted            = $00000040;
  1600.   faNormal               = $00000080;
  1601.   faTemporary            = $00000100;
  1602.   faSparceFile           = $00000200;
  1603.   faReparsePoint         = $00000400;
  1604.   faCompressed           = $00000800;
  1605.   faOffline              = $00001000;
  1606.   faNotContentIndexed    = $00002000;
  1607.  
  1608. type
  1609.  
  1610. { The TFile class encapsulates a file input output operations }
  1611.   TFile = class (TObjectX)
  1612.   private
  1613.     FFileName: TString;
  1614.     FHandle: HFile;
  1615.     FStatus: TFileStatus;
  1616.     FDummy: LongWord;
  1617.     procedure CreateBackup;
  1618.     function GetSize: Integer;
  1619.     function GetCreationTime: TFileTime;
  1620.     function GetLastAccessTime: TFileTime;
  1621.     function GetLastWriteTime: TFileTime;
  1622.     procedure SetCreationTime(const Value: TFileTime);
  1623.     procedure SetLastAccessTime(const Value: TFileTime);
  1624.     procedure SetLastWriteTime(const Value: TFileTime);
  1625.     function GetAttributes: LongInt;
  1626.     procedure SetAttributes(const Value: LongInt);
  1627.   protected
  1628. { The Error procedure raises an exception with specified error code }
  1629.     procedure Error(Code: Integer); dynamic;
  1630.  
  1631. { The GetErrorMessage function is used to obtain error message for specified
  1632.   error code }
  1633.     function GetErrorMessage(Code: Integer): TString; dynamic;
  1634.   public
  1635.     property FileName: TString read FFileName;
  1636.              // the name of a file
  1637.     property Status: TFileStatus read FStatus;
  1638.              // the status of a file (reading or writing)
  1639.     property Handle: HFile read FHandle;
  1640.              // the handle to a file
  1641.     property Size: Integer read GetSize;
  1642.              // the size of a file
  1643.     property CreationTime: TFileTime read GetCreationTime write SetCreationTime;
  1644.              // a file creation time
  1645.     property LastAccessTime: TFileTime read GetLastAccessTime write SetLastAccessTime;
  1646.              // a file last access time
  1647.     property LastWriteTime: TFileTime read GetLastWriteTime write SetLastWriteTime;
  1648.              // a file last write time
  1649.     property Attributes: LongInt read GetAttributes write SetAttributes;
  1650.              // a file attributes
  1651.  
  1652. { The Create constructor creates a new instance of this class and a new file to write
  1653.   data. If the Backup parameter is True and a file with specified file name already
  1654.   exist the old file will be renamed adding a ~ sign to its extension }
  1655.     constructor Create(AFileName: TString; Backup: Boolean);
  1656.  
  1657. { The Write procedure writes data to a file }
  1658.     procedure Write(const Buffer; Size: Integer);
  1659.  
  1660. { The Open constructor creates a new instance of this class and opens an existing file
  1661.   to read data }
  1662.     constructor Open(AFileName: TString);
  1663.  
  1664. { The Read procedure reads data from a file }
  1665.     procedure Read(var Buffer; Size: Integer);
  1666.  
  1667. { The Seek procedure sets the file pointer to desired position from the origin
  1668.   of a file }
  1669.     procedure Seek(Position: Integer);
  1670.  
  1671. { The Close procedure closes a file and destroys an instance }
  1672.     procedure Close;
  1673.  
  1674.     destructor Destroy; override;
  1675.  
  1676. { The DecodeDateTime procedure is used to obtain numerical date and time values from
  1677.   a value that is returned by CreateTime, LastAccessTime and LastWriteTime properties }
  1678.     class procedure DecodeDateTime(const DateTime: TFileTime;
  1679.      Year, Month, Day, Hour, Min, Sec: PWord);
  1680.  
  1681. { The EncodeDateTime procedure is used to make a value to assign it to
  1682.   CreateTime, LastAccessTime and LastWriteTime properties }
  1683.     class function EncodeDateTime(Year, Month, Day, Hour, Min, Sec: Word): TFileTime;
  1684.  
  1685.  
  1686. { The UserError procedure calls the protected Error method}
  1687.     procedure UserError(Code: Integer);
  1688.   end;
  1689.  
  1690.  
  1691. { The TFileStrm class has the same destination as TFile class but inherited from
  1692.   TStream class for compatibility with descendants of that class}
  1693.   TFileStrm = class (TStream)
  1694.   private
  1695.     FHandle: HFile;
  1696.     FStatus: TFileStatus;
  1697.     FFileName: TString;
  1698.     procedure CreateBackup;
  1699.     function GetAttributes: LongInt;
  1700.     function GetCreationTime: TFileTime;
  1701.     function GetLastAccessTime: TFileTime;
  1702.     function GetLastWriteTime: TFileTime;
  1703.     procedure SetAttributes(const Value: LongInt);
  1704.     procedure SetCreationTime(const Value: TFileTime);
  1705.     procedure SetLastAccessTime(const Value: TFileTime);
  1706.     procedure SetLastWriteTime(const Value: TFileTime);
  1707.   protected
  1708.     procedure SetSize(NewSize: LongInt); override;
  1709.     procedure Error(Code: Integer); dynamic;
  1710.     function GetErrorMessage(Code: Integer): TString; dynamic;
  1711.   public
  1712.     property FileName: TString read FFileName;
  1713.     property Status: TFileStatus read FStatus;
  1714.     property Handle: HFile read FHandle;
  1715.     property CreationTime: TFileTime read GetCreationTime write SetCreationTime;
  1716.     property LastAccessTime: TFileTime read GetLastAccessTime write SetLastAccessTime;
  1717.     property LastWriteTime: TFileTime read GetLastWriteTime write SetLastWriteTime;
  1718.     property Attributes: LongInt read GetAttributes write SetAttributes;
  1719.     constructor Create(AFileName: TString; Backup: Boolean);
  1720.     constructor Open(AFileName: TString);
  1721.     function Write(const Buffer; Count: LongInt): LongInt; override;
  1722.     function Read(var Buffer; Count: LongInt): LongInt; override;
  1723.     function Seek(Offset: LongInt; Origin: Word): LongInt; override;
  1724.     procedure Close;
  1725.     destructor Destroy; override;
  1726.  
  1727.     class procedure DecodeDateTime(const DateTime: TFileTime;
  1728.      Year, Month, Day, Hour, Min, Sec: PWord);
  1729.     class function EncodeDateTime(Year, Month, Day, Hout, Min, Sec: Word): TFileTime;
  1730.     procedure UserError(Code: Integer);
  1731.   end;
  1732.  
  1733. { 2D dynamic array class declaration }
  1734.   EMatrixError = class (Exception);
  1735.   TMatrix = class;
  1736.  
  1737.   PMatrixRow = ^TMatrixRow;
  1738.   TMatrixRow = class (TDynamicArray)
  1739.   private
  1740.     FMatrix: TMatrix;
  1741.   public
  1742.     property Matrix: TMatrix read FMatrix;
  1743.     constructor Create(AColCount: Integer; AMatrix: TMatrix);
  1744.   end;
  1745.  
  1746.   TMatrixRows = class (TDynamicArray)
  1747.   private
  1748.     FWidth: Integer;
  1749.     FColIndex: Integer;
  1750.     function GetRow(Index: Integer): TMatrixRow;
  1751.     procedure SetRow(Index: Integer; const Value: TMatrixRow);
  1752.     procedure SetWidth(const Value: Integer);
  1753.     function SetWidthFunc(Index: Integer; var Row: TMatrixRow): Integer;
  1754.     function InsertColFunc(Index: Integer; var Row: TMatrixRow): Integer;
  1755.     function DeleteColFunc(Index: Integer; var Row: TMatrixRow): Integer;
  1756.   public
  1757.     property Width: Integer read FWidth write SetWidth;
  1758.     property Row[Index: Integer]: TMatrixRow read GetRow write SetRow; default;
  1759.     procedure InsertCol(Index: Integer);
  1760.     procedure DeleteCol(Index: Integer);
  1761.     constructor Create(AMatrix: TMatrix);
  1762.   end;
  1763.  
  1764.   TMatrix = class (TUnknown)
  1765.   private
  1766.     FItemSize : Cardinal;
  1767.     FRows: TMatrixRows;
  1768.     function GetColCount: Integer;
  1769.     function GetRowCount: Integer;
  1770.     procedure SetColCount(const Value: Integer);
  1771.     procedure SetRowCount(const Value: Integer);
  1772.     function GetRow(Index: Integer): TMatrixRow;
  1773.   protected
  1774.     function CreateRow: TMatrixRow; virtual;
  1775.   public
  1776.     procedure GetItem(ACol, ARow: Integer; out Item);
  1777.     procedure PutItem(ACol, ARow: Integer; const Item);
  1778.     procedure InsertRow(Index: Integer);
  1779.     procedure DeleteRow(Index: Integer);
  1780.     procedure InsertCol(Index: Integer);
  1781.     procedure DeleteCol(Index: Integer);
  1782.     function ForEachRow(Tag: Integer; ForEachRowFunc: TForEachFunc): Integer;
  1783.     property ColCount: Integer read GetColCount write SetColCount;
  1784.     property RowCount: Integer read GetRowCount write SetRowCount;
  1785.     property Row[Index: Integer]: TMatrixRow read GetRow;
  1786.     constructor Create(AColCount, ARowCount, AItemSize: Integer);
  1787.     destructor Destroy; override;
  1788.   end;
  1789.  
  1790. implementation
  1791.  
  1792. uses Consts, SysConst, DimConst;
  1793.  
  1794. type
  1795.   TLangIDItem = packed record
  1796.    LangID:  Byte;
  1797.    Charset: Byte;
  1798.   end;
  1799.  
  1800. const
  1801.   LangCount = 33;
  1802.   LangIDToCharsetInfo : array [0..LangCount] of TLangIDItem = (
  1803.    (LangID: $01; Charset: ARABIC_CHARSET),
  1804.    (LangID: $02; Charset: RUSSIAN_CHARSET),
  1805.    (LangID: $04; Charset: CHINESEBIG5_CHARSET),
  1806.    (LangID: $05; Charset: EASTEUROPE_CHARSET),
  1807.    (LangID: $06; Charset: ANSI_CHARSET),
  1808.    (LangID: $07; Charset: ANSI_CHARSET),
  1809.    (LangID: $08; Charset: GREEK_CHARSET),
  1810.    (LangID: $09; Charset: ANSI_CHARSET),
  1811.    (LangID: $0A; Charset: ANSI_CHARSET),
  1812.    (LangID: $0B; Charset: ANSI_CHARSET),
  1813.    (LangID: $0C; Charset: ANSI_CHARSET),
  1814.    (LangID: $0D; Charset: HEBREW_CHARSET),
  1815.    (LangID: $0E; Charset: EASTEUROPE_CHARSET),
  1816.    (LangID: $0F; Charset: ANSI_CHARSET),
  1817.    (LangID: $10; Charset: ANSI_CHARSET),
  1818.    (LangID: $13; Charset: ANSI_CHARSET),
  1819.    (LangID: $14; Charset: ANSI_CHARSET),
  1820.    (LangID: $15; Charset: EASTEUROPE_CHARSET),
  1821.    (LangID: $16; Charset: ANSI_CHARSET),
  1822.    (LangID: $18; Charset: EASTEUROPE_CHARSET),
  1823.    (LangID: $19; Charset: RUSSIAN_CHARSET),
  1824.    (LangID: $1A; Charset: EASTEUROPE_CHARSET),
  1825.    (LangID: $1B; Charset: EASTEUROPE_CHARSET),
  1826.    (LangID: $1C; Charset: EASTEUROPE_CHARSET),
  1827.    (LangID: $1D; Charset: ANSI_CHARSET),
  1828.    (LangID: $1E; Charset: THAI_CHARSET),
  1829.    (LangID: $1F; Charset: TURKISH_CHARSET),
  1830.    (LangID: $22; Charset: RUSSIAN_CHARSET),
  1831.    (LangID: $23; Charset: RUSSIAN_CHARSET),
  1832.    (LangID: $24; Charset: EASTEUROPE_CHARSET),
  1833.    (LangID: $25; Charset: BALTIC_CHARSET),
  1834.    (LangID: $26; Charset: BALTIC_CHARSET),
  1835.    (LangID: $27; Charset: BALTIC_CHARSET),
  1836.    (LangID: $2a; Charset: VIETNAMESE_CHARSET));
  1837.  
  1838. function Hole(var A):Integer;
  1839. asm
  1840. end;
  1841.  
  1842. procedure Sync;
  1843. asm
  1844.    call WinNT
  1845.    test eax, 1
  1846.    jz   @@10
  1847.    ret
  1848. @@10:
  1849.    mov   dx,3dah
  1850. @@wait:
  1851.    in    al,dx
  1852.    test  al,8
  1853.    jz    @@wait
  1854. end;
  1855.  
  1856. function KeyPressed(VKey: Integer): LongBool;
  1857. asm
  1858.    push  eax
  1859.    call  GetKeyState
  1860.    and   eax, 0080h
  1861.    shr   al, 7
  1862. end;
  1863.  
  1864. function ScanCode(lKeyData: Integer): Byte;
  1865. asm
  1866.    shr   eax, 16
  1867.    and   ax, 00FFh
  1868. end;
  1869.  
  1870. function RightKey(lKeyData: Integer): Boolean;
  1871. asm
  1872.    shr   eax, 24
  1873.    and   ax, 0001h
  1874. end;
  1875.  
  1876. procedure EmulateKey(Wnd: HWND; VKey: Integer);
  1877. asm
  1878.    push   0
  1879.    push   edx
  1880.    push   0101H  //WM_KEYUP
  1881.    push   eax
  1882.    push   0
  1883.    push   edx
  1884.    push   0100H  //WM_KEYDOWN
  1885.    push   eax
  1886.    call   PostMessage
  1887.    call   PostMessage
  1888. end;
  1889.  
  1890.  
  1891. procedure Perspective(const X, Y, Z, Height, Basis: Extended; var XP, YP: Extended);
  1892. var
  1893.  Den: Extended;
  1894. begin
  1895.  Den:=Y+Basis;
  1896.  if Abs(Den)<1e-100 then Den:=1e-100;
  1897.  XP:=Basis*X/Den;
  1898.  YP:=(Basis*Z+Height*Y)/Den;
  1899. end;
  1900.  
  1901. function Interpolate(const X1, Y1, X2, Y2, X: Extended): Extended;
  1902. begin
  1903.  if X1=X2 then Result:=(Y1+Y2)/2 else Result:=(Y1*(X2-X)+Y2*(X-X1))/(X2-X1);
  1904. end;
  1905.  
  1906. function Det(a11, a12, a13, a21, a22, a23, a31, a32, a33: Double): Double;
  1907. begin
  1908.  Result:=a11*a22*a33-a11*a23*a32+
  1909.          a12*a23*a31-a12*a21*a33+
  1910.          a13*a21*a32-a13*a22*a31;
  1911. end;
  1912.  
  1913. procedure SinCos(Theta: Extended; var Sin, Cos: Extended);
  1914. asm
  1915.    fld     Theta
  1916.    fsincos
  1917.    fstp    tbyte ptr [edx]
  1918.    fstp    tbyte ptr [eax]
  1919.    fwait
  1920. end;
  1921.  
  1922. function Tan(Alpha: Extended): Extended;
  1923. asm
  1924.    fld   Alpha
  1925.    fptan
  1926.    fstp  st(0)
  1927.    fwait
  1928. end;
  1929.  
  1930. procedure GetLineEqn(Y1, Z1, Y2, Z2: Extended; var A, B, C: Extended);
  1931. var
  1932.  DY, DZ: Extended;
  1933. const
  1934.  Eps = 1e-20;
  1935. begin
  1936.  DY:=Abs(Y1-Y2); DZ:=Abs(Z1-Z2);
  1937.  if DY <= eps then begin
  1938.   A:=1; B:=0; C:=-Y1;
  1939.   Exit;
  1940.  end;
  1941.  if DZ <= eps then begin
  1942.   A := 0; B := 1; C := -Z1;
  1943.   Exit;
  1944.  end;
  1945.  if (DY > DZ) then begin
  1946.   A:=1;
  1947.   B:=(Y2 - Y1)/(Z1 - Z2);
  1948.  end else begin
  1949.   B:=1;
  1950.   A:=(Z2 - Z1)/(Y1 - Y2);
  1951.  end;
  1952.  C:=-A*Y1-B*Z1;
  1953. end;
  1954.  
  1955. function LinesIntersection(A1, B1, C1, A2, B2, C2: Extended; var Y, Z: Extended): Boolean;
  1956. var
  1957.  Det: Extended;
  1958. begin
  1959.  Det:=A1*B2-A2*B1;
  1960.  Result:=Abs(Det)>1e-20;
  1961.  if Result then begin
  1962.   Y := (c2*b1-c1*b2)/det;
  1963.   Z := (a2*c1-a1*c2)/det;
  1964.  end;
  1965. end;
  1966.  
  1967. function SegmentLength(const X1, Y1, X2, Y2: Extended): Extended;
  1968. asm
  1969.    fld   X1
  1970.    fld   X2
  1971.    fsub
  1972.    fld   st(0)
  1973.    fmul
  1974.    fld   Y1
  1975.    fld   Y2
  1976.    fsub
  1977.    fld   st(0)
  1978.    fmul
  1979.    fadd
  1980.    fsqrt
  1981.    fwait
  1982. end;
  1983.  
  1984. procedure Rotate(X, Y, X0, Y0, Alpha: Extended; var X1, Y1: Extended);
  1985. var
  1986.  Sin, Cos: Extended;
  1987.  DX, DY: Extended;
  1988. begin
  1989.  SinCos(Alpha, Sin, Cos);
  1990.  DX:=(X-X0); DY:=(Y-Y0);
  1991.  X1:=DX*Cos+DY*Sin+X0;
  1992.  Y1:=DY*Cos-DX*Sin+Y0;
  1993. end;
  1994.  
  1995. function LinesIntersection(Y1, Z1, Y2, Z2, Y3, Z3, Y4, Z4: Extended; var Y, Z: Extended): Boolean; overload;
  1996. var
  1997.  A1, B1, C1, A2, B2, C2: Extended;
  1998. begin
  1999.  GetLineEqn(Y1, Z1, Y2, Z2, A1, B1, C1);
  2000.  GetLineEqn(Y3, Z3, Y4, Z4, A2, B2, C2);
  2001.  Result:=LinesIntersection(A1, B1, C1, A2, B2, C2, Y, Z);
  2002. end;
  2003.  
  2004. procedure RebuildRect(var Rect:TRect);
  2005. asm
  2006.    push  esi
  2007.    push  edx
  2008.    mov   esi, eax
  2009.    mov   eax, [esi]
  2010.    mov   edx, [esi+8]
  2011.    cmp   eax, edx
  2012.    jl    @@10
  2013.    mov   [esi+8], eax
  2014.    mov   [esi], edx
  2015. @@10:
  2016.    mov   eax, [esi+4]
  2017.    mov   edx, [esi+12]
  2018.    cmp   eax, edx
  2019.    jl    @@20
  2020.    mov   [esi+12], eax
  2021.    mov   [esi+4], edx
  2022. @@20:
  2023.    mov   eax, esi
  2024.    pop   edx
  2025.    pop   esi
  2026. end;
  2027.  
  2028. procedure MoveRect(var Rect: TRect; DeltaX, DeltaY: Integer);
  2029. asm
  2030.    add   [eax], edx
  2031.    add   [eax+8], edx
  2032.    add   [eax+4], ecx
  2033.    add   [eax+12], ecx
  2034. end;
  2035.  
  2036.  
  2037. procedure CopyRect(const Source: TRect; var Dest: TRect);
  2038. asm
  2039.    mov   ecx, 16
  2040.    call  MoveMem
  2041. end;
  2042.  
  2043. procedure DeltaRect(var Rect: TRect; Delta: Integer);
  2044. asm
  2045.    call  RebuildRect
  2046.    add   [eax].TRect.Right, edx
  2047.    add   [eax].TRect.Bottom, edx
  2048.    sub   [eax].TRect.Top, edx
  2049.    sub   [eax].TRect.Left, edx
  2050. end;
  2051.  
  2052. function IsEmptyRect(const Rect: TRect): LongBool;
  2053. asm
  2054.    push  esi
  2055.    push  edx
  2056.    mov   esi, eax
  2057.    xor   eax, eax
  2058.    mov   edx, [esi]
  2059.    test  edx, edx
  2060.    jnz   @@10
  2061.    mov   edx, [esi+4]
  2062.    test  edx, edx
  2063.    jnz   @@10
  2064.    mov   edx, [esi+8]
  2065.    test  edx, edx
  2066.    jnz   @@10
  2067.    mov   edx, [esi+12]
  2068.    test  edx, edx
  2069.    jnz   @@10
  2070.    not   eax
  2071. @@10:
  2072.    pop   edx
  2073.    pop   esi
  2074. end;
  2075.  
  2076. function RectIntersection(const Rect1, Rect2: TRect): TRect;
  2077. begin
  2078.  RebuildRect(PRect(@Rect1)^);
  2079.  RebuildRect(PRect(@Rect2)^);
  2080.  if Inside(Rect2.TopLeft, Rect1) then begin
  2081.   if Inside(Rect2.BottomRight, Rect1) then begin
  2082.    Result:=Rect2;
  2083.    Exit;
  2084.   end else begin
  2085.    Result.TopLeft:=Rect2.TopLeft;
  2086.    Result.BottomRight:=Rect1.BottomRight;
  2087.    Exit;
  2088.   end;
  2089.  end;
  2090.  if Inside(Rect2.BottomRight, Rect1) then begin
  2091.   if Inside(Rect2.TopLeft,Rect1) then begin
  2092.    Result:=Rect2;
  2093.    Exit;
  2094.   end else begin
  2095.    Result.TopLeft:=Rect1.TopLeft;
  2096.    Result.BottomRight:=Rect2.BottomRight;
  2097.    Exit;
  2098.   end;
  2099.  end;
  2100.  if Inside(Rect1.TopLeft, Rect2) then begin
  2101.   if Inside(Rect1.BottomRight, Rect2) then begin
  2102.    Result:=Rect1;
  2103.    Exit;
  2104.   end else begin
  2105.    Result.TopLeft:=Rect1.TopLeft;
  2106.    Result.BottomRight:=Rect2.BottomRight;
  2107.    Exit;
  2108.   end;
  2109.  end;
  2110.  if Inside(Rect1.BottomRight, Rect2) then begin
  2111.   if Inside(Rect1.TopLeft, Rect2) then begin
  2112.    Result:=Rect1;
  2113.    Exit;
  2114.   end else begin
  2115.    Result.TopLeft:=Rect2.TopLeft;
  2116.    Result.BottomRight:=Rect1.BottomRight;
  2117.    Exit;
  2118.   end;
  2119.  end;
  2120.  ClearMem(Result, SizeOf(Result));
  2121. end;
  2122.  
  2123. function SamePoint(const Point1,Point2: TPoint):LongBool;
  2124. begin
  2125.  Result:=TWideInt(Point1)=TWideInt(Point2);
  2126. end;
  2127.  
  2128. function IsNullPoint(const Point: TPoint): LongBool;
  2129. begin
  2130.  Result:=not LongBool(TWideInt(Point));
  2131. end;
  2132.  
  2133. function ComparePointX(const Point1, Point2: TPoint): Integer;
  2134. asm
  2135.    push  esi
  2136.    push  edi
  2137.    mov   esi, eax
  2138.    mov   edi, edx
  2139.    mov   eax, [esi]
  2140.    mov   edx, [edi]
  2141.    cmp   eax, edx
  2142.    jle   @@10
  2143.    mov   eax, nMore
  2144.    jmp   @@50
  2145. @@10:
  2146.    je    @@20
  2147.    mov   eax, nLess
  2148.    jmp   @@50
  2149. @@20:
  2150.    mov   eax, [esi+4]
  2151.    mov   edx, [edi+4]
  2152.    cmp   eax, edx
  2153.    jle   @@30
  2154.    mov   eax, nMore
  2155.    jmp   @@50
  2156. @@30:
  2157.    je    @@40
  2158.    mov   eax, nLess
  2159.    jmp   @@50
  2160. @@40:
  2161.    mov   eax, nEqual
  2162. @@50:
  2163.    pop   edi
  2164.    pop   esi
  2165. end;
  2166.  
  2167. function ComparePointY(const Point1, Point2: TPoint): Integer;
  2168. asm
  2169.    push  esi
  2170.    push  edi
  2171.    mov   esi, eax
  2172.    mov   edi, edx
  2173.    mov   eax, [esi+4]
  2174.    mov   edx, [edi+4]
  2175.    cmp   eax, edx
  2176.    jle   @@10
  2177.    mov   eax, nMore
  2178.    jmp   @@50
  2179. @@10:
  2180.    je    @@20
  2181.    mov   eax, nLess
  2182.    jmp   @@50
  2183. @@20:
  2184.    mov   eax, [esi]
  2185.    mov   edx, [edi]
  2186.    cmp   eax, edx
  2187.    jle   @@30
  2188.    mov   eax, nMore
  2189.    jmp   @@50
  2190. @@30:
  2191.    je    @@40
  2192.    mov   eax, nLess
  2193.    jmp   @@50
  2194. @@40:
  2195.    mov   eax, nEqual
  2196. @@50:
  2197.    pop   edi
  2198.    pop   esi
  2199. end;
  2200.  
  2201. procedure MovePoint(var Point: TPoint; DispX, DispY: Integer);
  2202. asm
  2203.    add    [eax], edx
  2204.    add    [eax+4], ecx
  2205. end;
  2206.  
  2207. function CloseTo(const Point1, Point2: TPoint; Distance: Integer): LongBool;
  2208. begin
  2209.  Result:=Inside(Point2, Rect(Point1.X-Distance, Point1.Y-Distance,
  2210.                              Point1.X+Distance, Point1.Y+Distance));
  2211. end;
  2212.  
  2213. function GetAngle(Num, Den:Double):Double;
  2214. begin
  2215.  if Den<>0 then begin
  2216.   Result:=arctan(Num/Den);
  2217.   if Den<0 then Result:=HalfCycle+Result else if Num<0 then Result:=FullCycle+Result;
  2218.  end else begin
  2219.   if Num>0 then Result:=Quadrant else Result:=3*Quadrant;
  2220.  end;
  2221. end;
  2222.  
  2223. function GetAlpha(Y1, Z1, Y2, Z2, Y3, Z3:Double):Double;
  2224. var A1, A2:Double;
  2225. begin
  2226.  A1:=GetAngle(Z1-Z2,Y2-Y1);
  2227.  A2:=GetAngle(Z3-Z2,Y2-Y3);
  2228.  if A2<A1 then A2:=FullCycle+A2;
  2229.  Result:=A2-A1;
  2230. end;
  2231.  
  2232. function GetAlphaScr(X1, Y1, X2, Y2, X3, Y3:Double):Double;
  2233. var A1, A2:Double;
  2234. begin
  2235.  A1:=GetAngle(X2-X1,Y1-Y2);
  2236.  A2:=GetAngle(X2-X3,Y3-Y2);
  2237.  if A2<A1 then A2:=FullCycle+A2;
  2238.  Result:=A2-A1;
  2239. end;
  2240.  
  2241. function CenterPoint(const Rect: TRect): TPoint;
  2242. asm
  2243.    push  esi
  2244.    mov   esi, eax
  2245.    mov   eax, [esi]
  2246.    add   eax, [esi+8]
  2247.    shr   eax, 1
  2248.    mov   [edx].TPoint.x, eax
  2249.    mov   eax, [esi+4]
  2250.    add   eax, [esi+12]
  2251.    shr   eax, 1
  2252.    mov   [edx].TPoint.y, eax
  2253.    pop   esi
  2254. end;
  2255.  
  2256. function Max(const R1,R2:Integer):Integer;overload;
  2257. asm
  2258.    cmp eax, edx
  2259.    jng @@10
  2260.    ret
  2261. @@10:
  2262.    mov eax, edx
  2263. end;
  2264.  
  2265. function Max(const R1,R2:Extended):Extended;overload;
  2266. begin
  2267.  if R1>R2 then Result:=R1 else Result:=R2;
  2268. end;
  2269.  
  2270. function Max(const P1, P2: TPoint; CompareY: LongBool=False): TPoint; overload;
  2271. var
  2272.  F: function (const Point1, Point2: TPoint): Integer;
  2273. begin
  2274.  if CompareY then F:=ComparePointY else F:=ComparePointX;
  2275.  if F(P1, P2) = nMore then Result:=P1 else Result:=P1;
  2276. end;
  2277.  
  2278. function Min(const R1,R2:Integer):Integer;overload;
  2279. asm
  2280.   cmp eax, edx
  2281.   jnl @@10
  2282.   ret
  2283. @@10:
  2284.   mov eax, edx
  2285. end;
  2286.  
  2287. function Min(const R1,R2:Extended):Extended;overload;
  2288. begin
  2289.  if R1<R2 then Result:=R1 else Result:=R2;
  2290. end;
  2291.  
  2292. function Min(const P1, P2: TPoint; CompareY: LongBool = False): TPoint;
  2293. var
  2294.  F: function (const Point1, Point2: TPoint): Integer;
  2295. begin
  2296.  if CompareY then F:=ComparePointY else F:=ComparePointX;
  2297.  if F(P1, P2) = nLess then Result:=P1 else Result:=P2;
  2298. end;
  2299.  
  2300. procedure ArrangeMin(var R1, R2: Integer);
  2301. asm
  2302.    mov   ecx, [eax]
  2303.    cmp   ecx, [edx]
  2304.    jl    @@10
  2305.    xchg  ecx, [edx]
  2306.    mov   [eax], ecx
  2307. @@10:
  2308. end;
  2309.  
  2310. procedure ArrangeMax(var R1, R2: Integer);
  2311. asm
  2312.    mov   ecx, [eax]
  2313.    cmp   ecx, [edx]
  2314.    jg    @@10
  2315.    xchg  ecx, [edx]
  2316.    mov   [eax], ecx
  2317. @@10:
  2318. end;
  2319.  
  2320. function Sign(const Value:Integer):Integer;overload;
  2321. asm
  2322.    test eax, eax
  2323.    jl   @@10
  2324.    jg   @@20
  2325.    ret
  2326. @@10:
  2327.    mov  eax, -1
  2328.    ret
  2329. @@20:
  2330.    mov  eax, 1
  2331. end;
  2332.  
  2333. function Sign(const Value:Extended):Extended;overload;
  2334. begin
  2335.  if Value<0 then Result:=-1.0 else
  2336.   if Value>0 then Result:=1.0 else Result:=0.0;
  2337. end;
  2338.  
  2339. procedure Swap(var R1, R2: Integer);overload;
  2340. asm
  2341.    mov  ecx, [eax]
  2342.    xchg ecx, [edx]
  2343.    mov  [eax], ecx
  2344. end;
  2345.  
  2346. procedure Swap(var R1, R2:Extended);overload;
  2347. var Temp:Extended;
  2348. begin
  2349.  Temp:=R1;
  2350.  R1:=R2;
  2351.  R2:=Temp;
  2352. end;
  2353.  
  2354. procedure Swap(var R1,R2:Double);overload;
  2355. var Temp:Double;
  2356. begin
  2357.  Temp:=R1;
  2358.  R1:=R2;
  2359.  R2:=Temp;
  2360. end;
  2361.  
  2362. procedure Swap(var R1,R2:TString);overload;
  2363. var Temp:TString;
  2364. begin
  2365.  Temp:=R1;
  2366.  R1:=R2;
  2367.  R2:=Temp;
  2368. end;
  2369.  
  2370. function Inside(Value,Down,Up:Integer):LongBool;overload;
  2371. asm
  2372.    cmp   edx, ecx
  2373.    jl    @@10
  2374.    xchg  ecx, edx
  2375. @@10:
  2376.    cmp   eax, edx
  2377.    jnl   @@20
  2378.    xor   eax, eax
  2379.    ret
  2380. @@20:
  2381.    cmp   eax, ecx
  2382.    setng al
  2383.    and   eax, 0FFH
  2384. end;
  2385.  
  2386. function Inside(Value,Down,Up:Extended):LongBool;overload;
  2387. var
  2388.  Mx,Mn:Extended;
  2389. begin
  2390.  Mx:=Max(Down,Up);
  2391.  Mn:=Min(Down,Up);
  2392.  Result:=(Value>=Mn) and (Value<=Mx);
  2393. end;
  2394.  
  2395. function Inside(const Point:TPoint;const Rect:TRect):LongBool;overload;
  2396. asm
  2397.    push  esi
  2398.    push  edi
  2399.    push  ebx
  2400.    mov   esi, eax
  2401.    mov   edi, edx
  2402.    mov   eax, [esi]
  2403.    mov   edx, [edi]
  2404.    mov   ecx, [edi+8]
  2405.    call  Inside
  2406.    mov   ebx, eax
  2407.    mov   eax, [esi+4]
  2408.    mov   edx, [edi+4]
  2409.    mov   ecx, [edi+12]
  2410.    call  Inside
  2411.    and   eax, ebx
  2412.    pop   ebx
  2413.    pop   edi
  2414.    pop   esi
  2415. end;
  2416.  
  2417. function Center(Value:Integer;HiValue:Integer;LoValue:Integer=0):Integer;
  2418. asm
  2419.    sub edx, ecx
  2420.    sub edx, eax
  2421.    shr edx, 1
  2422.    add ecx, edx
  2423.    mov eax, ecx
  2424. end;
  2425.  
  2426. function IncPtr(P:Pointer;Delta:Integer=1):Pointer;register;
  2427. asm
  2428.    add   eax, edx
  2429. end;
  2430.  
  2431. function DecPtr(P:Pointer;Delta:Integer=1):Pointer;register;
  2432. asm
  2433.    sub eax, edx
  2434. end;
  2435.  
  2436. function Join(const LoWord, HiWord:word):Integer;
  2437. asm
  2438.    shl   edx, 16
  2439.    and   eax, 0FFFFh
  2440.    or    eax, edx
  2441. end;
  2442.  
  2443. procedure SetValue(P: Pointer; Value: Integer); register;
  2444. asm
  2445.    test eax, eax
  2446.    jz   @@10
  2447.    mov  [eax], edx
  2448. @@10:
  2449. end;
  2450.  
  2451. procedure SetIntValue(P: Pointer; Value: Integer);
  2452. asm
  2453.    test eax, eax
  2454.    jz   @@10
  2455.    mov  [eax], edx
  2456. @@10:
  2457. end;
  2458.  
  2459. procedure SetWordValue(P: Pointer; Value: word);
  2460. asm
  2461.    test eax, eax
  2462.    jz   @@10
  2463.    mov  [eax], dx
  2464. @@10:
  2465. end;
  2466.  
  2467. procedure SetByteValue(P: Pointer; Value: byte);
  2468. asm
  2469.    test eax, eax
  2470.    jz   @@10
  2471.    mov  [eax], dl
  2472. @@10:
  2473. end;
  2474.  
  2475. procedure DecInt(var N: Integer; Delta: Integer = 1; Lowest: Integer = 0);
  2476. asm
  2477.    push   ebx
  2478.    mov    ebx, [eax]
  2479.    sub    ebx, edx
  2480.    cmp    ebx, ecx
  2481.    jl     @@10
  2482.    mov    [eax], ebx
  2483.    pop    ebx
  2484.    ret
  2485. @@10:
  2486.    mov    [eax], ecx
  2487.    pop    ebx
  2488. end;
  2489.  
  2490. procedure IncInt(var N: Integer; Delta: Integer = 1; Highest: Integer = MaxInt);
  2491. asm
  2492.    push   ebx
  2493.    mov    ebx, [eax]
  2494.    add    ebx, edx
  2495.    cmp    ebx, ecx
  2496.    jg     @@10
  2497.    mov    [eax], ebx
  2498.    pop    ebx
  2499.    ret
  2500. @@10:
  2501.    mov    [eax], ecx
  2502.    pop    ebx
  2503. end;
  2504.  
  2505. function RoundPrev(Value, Divider: Integer): Integer;
  2506. {begin
  2507.  Result:=(Value div Divider) * Divider;}
  2508. asm
  2509.    mov  ecx, edx
  2510.    cdq
  2511.    idiv ecx
  2512.    imul ecx
  2513. end;
  2514.  
  2515. function RoundNext(Value, Divider: Integer): Integer;
  2516. asm
  2517.    mov   ecx, edx
  2518.    cdq
  2519.    idiv  ecx
  2520.    imul  ecx
  2521.    add   eax, ecx
  2522. end;
  2523.  
  2524. function BoolToSign(B: LongBool): Integer;
  2525. asm
  2526.    test  eax, eax
  2527.    jz    @@10
  2528.    xor   eax, eax
  2529.    dec   eax
  2530.    ret
  2531. @@10:
  2532.    inc   eax
  2533. end;
  2534.  
  2535. function FmtString(const Str:TString;const Values:array of TString):TString;
  2536. var
  2537.  i:Integer;
  2538. begin
  2539.  Result:=Str;
  2540.  for i:=High(Values) downto Low(Values) do
  2541.    Result:=ReplaceStrAll(Result, '%'+IntToStr(i+1), Values[i]);
  2542. end;
  2543.  
  2544. function FindChars(const Source:TString;const Chars:TSetChar;CurrentPosition:Integer=1;Direction:Integer=1):Integer;
  2545. var
  2546.  i,len:Integer;
  2547.  Delta:Integer;
  2548. begin
  2549.  Result:=0;
  2550.  if Direction<0 then Delta:=-1 else Delta:=1;
  2551.  i:=CurrentPosition;
  2552.  len:=Length(Source);
  2553.  if Len=0 then Exit;
  2554.  repeat
  2555.   if Source[i] in Chars then begin
  2556.    Result:=i;
  2557.    Break;
  2558.   end;
  2559.   i:=i+Delta;
  2560.   if (i<1) or (i>len) then Break;
  2561.  until false;
  2562. end;
  2563.  
  2564. function FindLastChar(const S: TString; Ch: Char = chSpace): Integer;
  2565. asm
  2566.    test  eax, eax
  2567.    jz    @@30
  2568.    mov   ecx, [eax - 4]
  2569.    test  ecx, ecx
  2570. @@10:
  2571.    jz    @@30
  2572.    mov   dh, [eax + ecx]
  2573.    cmp   dl, dh
  2574.    jne   @@20
  2575.    mov   eax, ecx
  2576.    inc   eax
  2577.    ret
  2578. @@20:
  2579.    dec   ecx
  2580.    jmp   @@10
  2581. @@30:
  2582.    xor   eax, eax
  2583.    dec   eax
  2584. end;
  2585.  
  2586. function LeftTrim(const Str:TString;const Chr:Char=chSpace):TString;
  2587. var
  2588.  Count:Integer;
  2589. begin
  2590.  Result:=Str;
  2591.  Count:=0;
  2592.  while Length(Result)>0 do begin
  2593.   if Result[Count+1]=Chr then Inc(Count) else Break;
  2594.  end;
  2595.  if Count<>0 then Delete(Result,1,Count);
  2596. end;
  2597.  
  2598. function LeftTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  2599. var
  2600.  Count:Integer;
  2601. begin
  2602.  Result:=Str;
  2603.  Count:=0;
  2604.  while Length(Result)>0 do begin
  2605.   if Result[Count+1] in Chrs then Inc(Count) else Break;
  2606.  end;
  2607.  if Count<>0 then Delete(Result,1,Count);
  2608. end;
  2609.  
  2610.  
  2611. function RightTrim(const Str:TString;const Chr:Char=chSpace):TString;
  2612. var Count:Integer;
  2613. begin
  2614.  Result:=Str;
  2615.  Count:=0;
  2616.  while Length(Result)>0 do begin
  2617.   if Result[Length(Result)-Count]=Chr then Inc(Count) else Break;
  2618.  end;
  2619.  if Count<>0 then SetLength(Result,Length(Result)-Count);
  2620. end;
  2621.  
  2622.  
  2623. function RightTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  2624. var Count:Integer;
  2625. begin
  2626.  Result:=Str;
  2627.  Count:=0;
  2628.  while Length(Result)>0 do begin
  2629.   if Result[Length(Result)-Count] in Chrs then Inc(Count) else Break;
  2630.  end;
  2631.  if Count<>0 then SetLength(Result,Length(Result)-Count);
  2632. end;
  2633.  
  2634. function LeftExpand(const Str:TString; Count: Integer; const Chr:Char=chSpace): TString;
  2635. var
  2636.  i:Integer;
  2637.  PS, PD: PChar;
  2638. begin
  2639.  if Count<0 then Count:=0;
  2640.  SetString(Result, nil, Length(Str)+Count);
  2641.  PS:=@Str[1];
  2642.  PD:=@Result[Count+1];
  2643.  for i:=1 to Count do Result[i]:=Chr;
  2644.  Move(PS^, PD^, Length(Str));
  2645. end;
  2646.  
  2647. function RightExpand(const Str:TString; Count: Integer; const Chr:Char=chSpace): TString;
  2648. var
  2649.  L: Integer;
  2650. begin
  2651.  if Count<0 then Count:=0;
  2652.  L:=GetLength(Str);
  2653.  SetString(Result, nil, L+Count);
  2654.  MoveMem(PChar(Str)^, PChar(Result)^, L);
  2655.  FillMem(PChar(@Result[L+1])^, Count, Byte(Chr));
  2656. end;
  2657.  
  2658. function TrimStr(const Str:TString;const Chr:Char=chSpace):TString;
  2659. begin
  2660.  if Str='' then Result:='' else Result:=LeftTrim(RightTrim(Str,Chr),Chr);
  2661. end;
  2662.  
  2663. function LeadTrim(const Str:TString; Count:Integer=1):TString;
  2664. begin
  2665.  if Count<0 then Count:=0;
  2666.  SetString(Result, PChar(IncPtr(PChar(Str), Count)), Length(Str)-Count);
  2667. end;
  2668.  
  2669. function TrailTrim(const Str:TString; Count:Integer=1):TString;
  2670. begin
  2671.  if Count<0 then Count:=0;
  2672.  SetString(Result, PChar(Str), Length(Str)-Count);
  2673. end;
  2674.  
  2675. function GetSubStr(const Str:TString;N:byte;Separator:Char=chSpace):TString;
  2676. var
  2677.  S: PChar;
  2678.  P1, P2: Integer;
  2679. begin
  2680.  P1:=CharEntryPos(Str, Separator, N-1);
  2681.  Inc(P1);
  2682.  S:=@Str[P1];
  2683.  P2:=CharEntryPos(S, Separator, 1);
  2684.  if P2=0 then P2:=Length(Str) else P2:=P1+P2-1;
  2685.  Result:=TrimStr(ReadSubStr(Str, P1, P2), Separator);
  2686.  if Result=Separator then Result:='';
  2687. end;
  2688.  
  2689. function ExtractStr(const Str:TString;N:byte):TString;
  2690. var
  2691.  P,I:Integer;
  2692.  S:TString;
  2693. begin
  2694.  S:=Str;
  2695.  for i:=1 to n-1 do begin
  2696.   P:=Pos(chSpace,S);
  2697.   S:=Copy(S,Succ(P),Length(S)-P);
  2698.   S:=LeftTrim(S);
  2699.  end;
  2700.  P:=Pos(chSpace,S);
  2701.  if P<>0 then Result:=Copy(S,1,Pred(P))
  2702.          else Result:=S;
  2703. end;
  2704.  
  2705. procedure ExtractStrings(Str: TString; List: TStrings; Separator: Char);
  2706. var
  2707.  P1, P2: PChar;
  2708. begin
  2709.  List.BeginUpdate;
  2710.  try
  2711.   List.Clear;
  2712.   P1:=PChar(Str);
  2713.   repeat
  2714.    P2:=StrScan(P1, Separator);
  2715.    SetByteValue(P2, 0);
  2716.    List.Add(P1);
  2717.    P1:=P2;
  2718.    Inc(P1);
  2719.   until P2 = nil;
  2720.  finally
  2721.   List.EndUpdate;
  2722.  end;
  2723. end;
  2724.  
  2725. function RemoveChars(const Str:TString;const Chars:TSetChar):TString;
  2726. var i:Integer;
  2727. begin
  2728.  Result:='';
  2729.  for i:=1 to Length(Str) do if not (Str[i] in Chars) then Result:=Result+Str[i];
  2730. end;
  2731.  
  2732. function ReplaceChar(const Str:TString;OldChar,NewChar:Char):TString;
  2733. var
  2734.  i:Integer;
  2735. begin
  2736.  Result:=Str;
  2737.  for i:=1 to Length(Result) do if Result[i]=OldChar then Result[i]:=NewChar;
  2738. end;
  2739.  
  2740. function ReplaceStr(const Str:TString;const OldSubStr,NewSubStr:TString):TString;
  2741. var
  2742.  P:Integer;
  2743. begin
  2744.  Result:=Str;
  2745.  P:=Pos(OldSubStr,Result);
  2746.  if P<>0 then begin
  2747.   Delete(Result,P,Length(OldSubStr));
  2748.   Insert(NewSubStr,Result,P);
  2749.  end;
  2750. end;
  2751.  
  2752. function __pos(SubStr, Str: TString; var P: Integer): Integer;
  2753. begin
  2754.  P:=Pos(SubStr, Str);
  2755.  Result:=P;
  2756. end;
  2757.  
  2758. function ReplaceStrAll(const Str: TString; const OldSubStr, NewSubStr: TString): TString;
  2759. var
  2760.  P: Integer;
  2761.  Len: Integer;
  2762. begin
  2763.  Result:=Str;
  2764.  Len:=Length(OldSubStr);
  2765.  while __pos(OldSubStr, Result, P)<>0 do begin
  2766.    Delete(Result, P, Len);
  2767.    Insert(NewSubStr, Result, P);
  2768.  end;
  2769. end;
  2770.  
  2771. procedure CleanUp(var Str: TString);
  2772. asm
  2773.    mov   eax, [eax]
  2774.    test  eax, eax
  2775.    jz    @@10
  2776.    push  eax
  2777.    call  GetLength
  2778.    mov   edx, eax
  2779.    pop   eax
  2780.    mov   [eax-4], edx
  2781. @@10:
  2782. end;
  2783.  
  2784. procedure CleanUp(var Str:TString; DoTrim: LongBool);
  2785. begin
  2786. // SetLength(Str,GetLength(Str));
  2787.  CleanUp(Str);
  2788.  if DoTrim then Str:=TrimStr(Str);
  2789. end;
  2790.  
  2791. function FillString(Chr:Char;Count:Integer):TString;
  2792. begin
  2793.  SetString(Result, nil, Count);
  2794.  FillChar(Pointer(Result)^, Count, Chr);
  2795. end;
  2796.  
  2797. function UpString(const Str:TString):TString;
  2798. begin
  2799.  Result:=Str;
  2800.  CharUpper(@Result[1]);
  2801. end;
  2802.  
  2803. function DnString(const Str:TString):TString;
  2804. begin
  2805.  Result:=Str;
  2806.  CharLower(@Result[1]);
  2807. end;
  2808.  
  2809. function GetChar(const Str:TString; Position:Integer=1):Char; register;
  2810. asm
  2811.    push  edi
  2812.    push  esi
  2813.    mov   edi, edx
  2814.    mov   esi, eax
  2815.    call  GetLength
  2816.    test  eax, eax
  2817.    jnz   @@10
  2818.    jmp   @@30
  2819. @@10:
  2820.    cmp   eax, edi
  2821.    jnb   @@20
  2822.    xor   eax, eax
  2823.    jmp   @@30
  2824. @@20:
  2825.    mov   eax, esi
  2826.    mov   edx, edi
  2827.    dec   edx
  2828.    call  ReadChar
  2829. @@30:
  2830.    pop   esi
  2831.    pop   edi
  2832. end;
  2833.  
  2834. function ReadChar(Ptr:Pointer;Offset:Integer):Char; register;
  2835. asm
  2836.    add   eax, edx
  2837.    mov   al, [eax]
  2838. end;
  2839.  
  2840. function UpChar(Ch:Char):Char; register;
  2841. asm
  2842.    and   eax, 000000FFh
  2843.    push  eax
  2844.    call  CharUpper
  2845. end;
  2846.  
  2847. function DnChar(Ch:Char):Char; register;
  2848. asm
  2849.    and   eax, 000000FFh
  2850.    push  eax
  2851.    call  CharLower
  2852. end;
  2853.  
  2854. function ReflectStr(const Str:TString):TString;
  2855. var
  2856.  i:Integer;
  2857.  len:Integer;
  2858. begin
  2859.  Len:=GetLength(Str);
  2860.  SetLength(Result,len);
  2861.  for i:=1 to Len do Result[i]:=Str[Len-i+1];
  2862. end;
  2863.  
  2864. function ReadSubStr(const Str:TString; Head, Tail:Integer):TString;
  2865. begin
  2866.  Result:=Copy(Str, Head, Tail-Head+1);
  2867. end;
  2868.  
  2869. function StrToFlt(const Str:TString;var Code:Integer):Extended;overload;
  2870. begin
  2871.  Val(PChar(Str), Result, Code);
  2872. end;
  2873.  
  2874. function StrToFlt(const Str:TString):Extended;overload;
  2875. var
  2876.  i:Integer;
  2877. begin
  2878.  Result:=StrToFlt(Str, i);
  2879.  if i<>0 then Result:=0;
  2880. end;
  2881.  
  2882. function FltToStr(const Value:Extended;Precision:Integer=5):TString;
  2883. var
  2884.  P:Integer;
  2885. begin
  2886.  Result:=FloatToStrF(Value,ffGeneral,Precision,0);
  2887.  P:=Pos(',',Result);
  2888.  if P<>0 then Result[P]:=chPoint;
  2889.  P:=Pos(DecimalSeparator,Result);
  2890.  if P<>0 then Result[P]:=chPoint;
  2891. end;
  2892.  
  2893. function BreakStr(const Str:TString;Len:Integer=64;AltChar:Char='\'):TString;
  2894. var
  2895.  i,j:Integer;
  2896.  Alt:Boolean;
  2897. begin
  2898.  if Length(Str)<=Len then begin
  2899.   Result:=Str;
  2900.   Exit;
  2901.  end;
  2902.  Result:='';
  2903.  i:=0;
  2904.  repeat
  2905.   j:=i+Len;
  2906.   if j>Length(Str) then begin
  2907.    j:=Length(Str);
  2908.    Result:=Result+Copy(Str,i+1,j-i);
  2909.    Exit;
  2910.   end;
  2911.   Alt:=False;
  2912.   while Str[j]<>chSpace do begin
  2913.    Dec(j);
  2914.    if j=i then begin
  2915.     Alt:=True;
  2916.     Break;
  2917.    end;
  2918.   end;
  2919.   if Alt then begin
  2920.    j:=i+Len;
  2921.    if j>Length(Str) then begin
  2922.     j:=Length(Str);
  2923.     Result:=Result+Copy(Str,i+1,j-i);
  2924.     Exit;
  2925.    end;
  2926.    while Str[j]<>AltChar do begin
  2927.     Dec(j);
  2928.     if j=i then begin
  2929.      j:=i+Len;
  2930.      Break;
  2931.     end;
  2932.    end;
  2933.   end;
  2934.   Result:=Result+Copy(Str,i+1,j-i)+#13#10;
  2935.   i:=j;
  2936.  until i>=Length(Str);
  2937. end;
  2938.  
  2939. function ValidInt(const Value:TString):LongBool;
  2940. var
  2941.  i,Code:Integer;
  2942. begin
  2943.  Val(Value,i,Code);
  2944.  Hole(i);
  2945.  Result:=Code=0;
  2946. end;
  2947.  
  2948. function ValidFloat(const Value:TString):LongBool;
  2949. var
  2950.  i:Double;
  2951.  Code:Integer;
  2952. begin
  2953.  Val(Value,i,Code);
  2954.  Hole(i);
  2955.  Result:=Code=0;
  2956. end;
  2957.  
  2958. function ValidFloatINF(const Value:TString): LongBool;
  2959. var
  2960.  R: Double;
  2961.  Code:Integer;
  2962. begin
  2963.  Val(Value, R, Code);
  2964.  Hole(Code);
  2965.  Result:=Infinity(R)=0;
  2966. end;
  2967.  
  2968.  
  2969. function ValidateFloat(const Value:TString):TString;
  2970. var
  2971.  P:Integer;
  2972. begin
  2973.  Result:=Value;
  2974.  P:=Pos(DecimalSeparator,Result);
  2975.  if P<>0 then Result[P]:=chPoint;
  2976.  P:=Pos(chComma,Result);
  2977.  if P<>0 then Result[p]:=chPoint;
  2978.  if not ValidFloat(Result) then Result:='';
  2979. end;
  2980.  
  2981. function Join(const Str1, Str2: TString): TString;
  2982. begin
  2983.  Result:='';
  2984.  if not IsEmptyStr(Str1) then Result:=PChar(@Str1[1]);
  2985.  if not IsEmptyStr(Str2) then Result:=Result+PChar(@Str2[1]);
  2986. end;
  2987.  
  2988. function LastChar(const Str:TString):Char;
  2989. begin
  2990.  if Str='' then Result:=chNull else Result:=Str[Length(Str)];
  2991. end;
  2992.  
  2993. function NextChar(const Str:TString;Pos:Integer;Passed:Char=chSpace):Char;
  2994. begin
  2995.  Result:=NextChar(Str,Pos,[Passed]);
  2996. end;
  2997.  
  2998. function PrevChar(const Str:TString;Pos:Integer;Passed:Char=chSpace):Char;
  2999. begin
  3000.  Result:=PrevChar(Str,Pos,[Passed]);
  3001. end;
  3002.  
  3003. function NextChar(const Str:TString;Pos:Integer;Passed:TSetChar):Char;overload;
  3004. var i:Integer;
  3005. begin
  3006.  Result:=#0;
  3007.  for i:=Pos+1 to Length(Str) do if not (Str[i] in Passed) then begin
  3008.   Result:=Str[i];
  3009.   Break;
  3010.  end;
  3011. end;
  3012.  
  3013. function PrevChar(const Str:TString;Pos:Integer;Passed:TSetChar):Char;overload;
  3014. var i:Integer;
  3015. begin
  3016.  Result:=#0;
  3017.  for i:=Pos-1 downto 1 do if not (Str[i] in Passed) then begin
  3018.   Result:=Str[i];
  3019.   Break;
  3020.  end;
  3021. end;
  3022.  
  3023. procedure AddString(var Str:TString; const Value:TString);
  3024. begin
  3025.  CleanUp(Str);
  3026.  Str:=Str+Value;
  3027. end;
  3028.  
  3029. function AdjustLength(Str: TString; Len: Integer; Ch: Char = chSpace): TString;
  3030. var
  3031.  L, N: Integer;
  3032.  S1: TString;
  3033. begin
  3034.  L:=GetStrLen(Str);
  3035.  if L<Len then begin
  3036.   N:=Len - L;
  3037.   SetString(S1, nil, N);
  3038.   FillMem(PChar(S1)^, N, Ord(Ch));
  3039.   Result:=Str+S1;
  3040.  end else Result:=Str;
  3041. end;
  3042.  
  3043. function CharCount(const Str:TString;Ch:Char):Integer; register;
  3044. asm
  3045.    push  edi
  3046.    test  eax, eax
  3047.    jnz   @@10
  3048.    xor   eax, eax
  3049.    jmp   @@40
  3050. @@10:
  3051.    mov   edi, eax
  3052.    xor   eax, eax
  3053.    dec   edi
  3054. @@20:
  3055.    inc   edi
  3056.    mov   dh, [edi]
  3057.    cmp   dh, dl
  3058.    jne   @@30
  3059.    inc   eax
  3060. @@30:
  3061.    test  dh, dh
  3062.    jnz   @@20
  3063. @@40:
  3064.    pop   edi
  3065. end;
  3066.  
  3067. function CopyToBuf(const Source:TString; Buf:PChar; Size:Integer):LongBool;
  3068. var
  3069.  Len: Integer;
  3070. begin
  3071.  Len:=GetLength(Source)+1;
  3072.  if Len>Size then begin
  3073.   Result:=False;
  3074.   Buf^:=#0;
  3075.  end else begin
  3076.   if not IsEmptyStr(Source) then MoveMem(PChar(Source)^, Buf^, Len)
  3077.                             else ClearMem(Buf^, Size);
  3078.   Result:=True;
  3079.  end;
  3080. end;
  3081.  
  3082. function MatchString(const Str:TString; const Values:array of TString;
  3083.                       CaseSensitive:LongBool=False):Integer;
  3084. {var
  3085.  i:Integer;
  3086.  fnTest:function(const S1,S2:TString):LongBool;
  3087. begin
  3088.  if not CaseSensitive then fnTest:=EqualText else fnTest:=EqualStr;
  3089.  Result:=0;
  3090.  for i:=Low(Values) to High(Values) do if fnTest(Str,Values[i]) then begin
  3091.   Result:=Succ(i);
  3092.   Break;
  3093.  end;}
  3094. var
  3095.    Count: LongInt;
  3096.    NS, LS: LongInt;
  3097. asm
  3098.    push  esi
  3099.    push  edi
  3100.    push  ebx
  3101.    test  eax, eax
  3102.    jnz   @@5
  3103.    mov   NS, eax
  3104.    mov   LS, eax
  3105.    lea   eax, NS
  3106. @@5:
  3107.    mov   esi, eax
  3108.    mov   edi, edx
  3109.    xor   ebx, ebx
  3110.    mov   eax, CaseSensitive
  3111.    not   eax
  3112.    and   eax, 1
  3113.    mov   CaseSensitive, eax
  3114.    mov   Count, ecx
  3115. @@10:
  3116.    cmp   ebx, Count
  3117.    jg    @@30
  3118.    push  dword ptr [esi-4]
  3119.    push  esi
  3120.    mov   eax, [edi+ebx*4]
  3121.    test  eax, eax
  3122.    jnz   @@15
  3123.    mov   NS, eax
  3124.    mov   LS, eax
  3125.    lea   eax, NS
  3126. @@15:
  3127.    push  dword ptr [eax-4]
  3128.    push  eax
  3129.    push  CaseSensitive
  3130.    push  LOCALE_USER_DEFAULT
  3131.    call  CompareString
  3132.    cmp   eax, 2
  3133.    je    @@20
  3134.    inc   ebx
  3135.    jmp   @@10
  3136. @@20:
  3137.    mov   eax, ebx
  3138.    inc   eax
  3139.    jmp   @@40
  3140. @@30:
  3141.    xor   eax, eax
  3142. @@40:
  3143.    pop   ebx
  3144.    pop   edi
  3145.    pop   esi
  3146. end;
  3147.  
  3148. function MatchStringEx(const Str:TString; const Values:Pointer; Count:Integer;
  3149.                             CaseSensitive:LongBool=False):Integer;
  3150. asm
  3151.    push  CaseSensitive
  3152.    call  MatchString
  3153. end;
  3154.  
  3155. function Among(N: Integer; const Values: array of Integer):LongBool;
  3156. asm
  3157.    push   ebx
  3158.    xor    ebx, ebx
  3159. @@10:
  3160.    test   ecx, ecx
  3161.    jl     @@30
  3162.    cmp    eax, [edx]
  3163.    jne    @@20
  3164.    not    ebx
  3165.    jmp    @@30
  3166. @@20:
  3167.    add    edx, 4
  3168.    dec    ecx
  3169.    jmp    @@10
  3170. @@30:
  3171.    mov    eax, ebx
  3172.    pop    ebx
  3173. end;
  3174.  
  3175. function __Parameters: TString;
  3176. var
  3177.  S: PChar;
  3178.  P: Integer;
  3179. begin
  3180.  Result:=GetCommandLine;
  3181.  if Result[1] = '"' then begin
  3182.   S:=@Result[2];
  3183.   P:=Pos('"', S);
  3184.   if P<>0 then Result:=ReadSubStr(S, P+2, Length(S)) else begin
  3185.    P:=Pos(chSpace, Result);
  3186.    if P = 0 then Result:='' else Result:=ReadSubStr(Result, P+1, Length(Result));
  3187.   end;
  3188.  end else begin
  3189.   P:=Pos(chSpace, Result);
  3190.   if P = 0 then Result:='' else Result:=ReadSubStr(Result, P+1, Length(Result));
  3191.  end;
  3192. end;
  3193.  
  3194. var
  3195.  ParametersFirstCall: Boolean = True;
  3196.  ParamString: TString = '';
  3197.  
  3198. function Parameters: TString;
  3199. begin
  3200.  if ParametersFirstCall then begin
  3201.   ParamString:=__Parameters;
  3202.   ParametersFirstCall:=False;
  3203.  end;
  3204.  Result:=ParamString;
  3205. end;
  3206.  
  3207. function _GetTempDirectory: TString;
  3208. var
  3209.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  3210. begin
  3211.  GetTempPath(SizeOf(Buf), @Buf);
  3212.  Result:=IncludeTrailingBackslash(PChar(@Buf));
  3213. end;
  3214.  
  3215. var
  3216.  TmpDir: TString = '';
  3217.  GetTempDirectoryFirstCall: Boolean = True;
  3218.  
  3219. function GetTempDirectory: TString;
  3220. begin
  3221.  if GetTempDirectoryFirstCall then begin
  3222.   TmpDir:=_GetTempDirectory;
  3223.   GetTempDirectoryFirstCall:=False;
  3224.  end;
  3225.  Result:=TmpDir;
  3226. end;
  3227.  
  3228. function GetTempFile(const Prefix: TString): TString;
  3229. var
  3230.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  3231. begin
  3232.  GetTempFileName(PChar(GetTempDirectory), PChar(Prefix), 0, @Buf);
  3233.  Result:=PChar(@Buf);
  3234. end;
  3235.  
  3236. var
  3237.  Checked: Boolean = False;
  3238.  Embedded: Boolean = False;
  3239.  
  3240. function CheckAutomation: Boolean;
  3241. begin
  3242.  if not Checked then begin
  3243.   Embedded:=MatchString(Parameters, ['-EMBEDDING', '/EMBEDDING'])<>0;
  3244.   Checked:=True;
  3245.  end;
  3246.  Result:=Embedded;
  3247. end;
  3248.  
  3249. function ExeName:TString;
  3250. var
  3251.  S: PChar;
  3252.  P: Integer;
  3253. begin
  3254.  Result:=GetCommandLine;
  3255.  S:=@Result[2];
  3256.  P:=Pos('"', S);
  3257.  Result:=ReadSubStr(S, 1, P-1);
  3258. end;
  3259.  
  3260. function ExePath:TString;
  3261. begin
  3262.  Result:=ExtractFilePath(ExeName);
  3263. end;
  3264.  
  3265. function ExeVersion: TString;
  3266. begin
  3267.  Result:=VersionToString(FileVersion);
  3268. end;
  3269.  
  3270. function InstanceName:TString;
  3271. var
  3272.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  3273. begin
  3274.  GetModuleFileName(hInstance, Buf, MAX_PATH);
  3275.  Result:=Buf;
  3276. end;
  3277.  
  3278. function InstancePath:TString;
  3279. begin
  3280.  Result:=ExtractFilePath(InstanceName);
  3281. end;
  3282.  
  3283. function FileVersion(const FileName: TString = ''): TFileVersion;
  3284. var
  3285.  S: TString;
  3286.  hMem: HGLOBAL;
  3287.  Buf: pointer;
  3288.  BufSize, Len, dwHandle: DWORD;
  3289.  VerInfo: PVSFixedFileInfo;
  3290.  pszName: PAnsiChar;
  3291. begin
  3292.  FillChar(Result, SizeOf(Result), 0);
  3293.  S:=FileName;
  3294.  CleanUp(S, True);
  3295.  if IsEmptyStr(S) then S:=ParamStr(0);
  3296.  pszName:=@S[1];
  3297.  BufSize:=GetFileVersionInfoSize(pszName, dwHandle);
  3298.  if BufSize<>0 then begin
  3299.   hMem:=GlobalAlloc(GHND, BufSize);
  3300.   if hMem = 0 then OutOfMemoryError;
  3301.   Buf:=GlobalLock(hMem);
  3302.   if Buf=nil then OutOfMemoryError;
  3303.   GetFileVersionInfo(pszName, dwHandle, BufSize, Buf);
  3304.   VerQueryValue(Buf, '\', pointer(VerInfo), Len);
  3305.   with VerInfo^ do begin
  3306.    Result.HiVersion:=HiWord(dwFileVersionMS);
  3307.    Result.LoVersion:=LoWord(dwFileVersionMS);
  3308.    Result.Release:=HiWord(dwFileVersionLS);
  3309.    Result.Build:=LoWord(dwFileVersionLS);
  3310.   end;
  3311.   GlobalUnlock(hMem);
  3312.   GlobalFree(hMem);
  3313.  end else Result.HiVersion:=-1;
  3314. end;
  3315.  
  3316. function ComCtlVersion: TFileVersion;
  3317. begin
  3318.  Result:=FileVersion('COMCTL32.DLL');
  3319. end;
  3320.  
  3321. function IsDebug(const FileName:  TString): LongBool;
  3322. var
  3323.  S: TString;
  3324.  hMem: HGLOBAL;
  3325.  Buf: pointer;
  3326.  BufSize, Len, dwHandle: DWORD;
  3327.  VerInfo: PVSFixedFileInfo;
  3328.  pszName: PAnsiChar;
  3329. begin
  3330.  Result:=False;
  3331.  FillChar(Result, SizeOf(Result), 0);
  3332.  S:=FileName;
  3333.  CleanUp(S, True);
  3334.  if IsEmptyStr(S) then S:=ParamStr(0);
  3335.  pszName:=@S[1];
  3336.  BufSize:=GetFileVersionInfoSize(pszName, dwHandle);
  3337.  if BufSize<>0 then begin
  3338.   hMem:=GlobalAlloc(GHND, BufSize);
  3339.   if hMem = 0 then OutOfMemoryError;
  3340.   Buf:=GlobalLock(hMem);
  3341.   if Buf=nil then OutOfMemoryError;
  3342.   GetFileVersionInfo(pszName, dwHandle, BufSize, Buf);
  3343.   VerQueryValue(Buf, '\', pointer(VerInfo), Len);
  3344.   Result:=(VerInfo.dwFileFlags and VS_FF_DEBUG) <> 0;
  3345.   GlobalUnlock(hMem);
  3346.   GlobalFree(hMem);
  3347.  end;
  3348. end;
  3349.  
  3350. var
  3351.  IsDebugValue: Integer = Integer($8000000);
  3352.  
  3353. function IsDebug: LongBool; overload;
  3354. begin
  3355.  if IsDebugValue = Integer ($80000000) then IsDebugValue:=Integer(IsDebug(''));
  3356.  Result:=LongBool(IsDebugValue);
  3357. end;
  3358.  
  3359. procedure GetWindowSize(Handle: HWND; var Size: TSize);
  3360. var
  3361.  R: TRect;
  3362. begin
  3363.  GetWindowRect(Handle, R);
  3364.  with R, Size do begin
  3365.   cx:=Right-Left;
  3366.   cy:=Bottom-Top;
  3367.  end;
  3368. end;
  3369.  
  3370. procedure GetWindowCenter(Handle: HWND; CenterX, CenterY: PInteger);
  3371. var
  3372.  R: TRect;
  3373. asm
  3374.   push   esi
  3375.   push   edi
  3376.   mov    esi, ecx
  3377.   mov    edi, edx
  3378.   lea    ecx, R
  3379.   push   ecx
  3380.   push   eax
  3381.   call   GetWindowRect
  3382.   test   edi, edi
  3383.   jz     @@10
  3384.   mov    eax, R.Right
  3385.   sub    eax, R.Left
  3386.   shr    eax, 1
  3387.   mov    [edi], eax
  3388. @@10:
  3389.   test   esi, esi
  3390.   jz     @@20
  3391.   mov    eax, R.Bottom
  3392.   sub    eax, R.Top
  3393.   shr    eax, 1
  3394.   mov    [esi], eax
  3395. @@20:
  3396.   pop    edi
  3397.   pop    esi
  3398. end;
  3399.  
  3400. procedure PressKey(VKey: Byte);
  3401. begin
  3402.  keybd_event(VKey, 0, 0, 0);
  3403.  keybd_event(VKey, 0, KEYEVENTF_KEYUP, 0);
  3404. end;
  3405.  
  3406. function ForceDirectories(Dir: TString): Boolean;
  3407. begin
  3408.  try
  3409.   Result := True;
  3410.   if Length(Dir) = 0 then Abort;
  3411.   Dir := ExcludeTrailingBackslash(Dir);
  3412.   if (Length(Dir) < 3) or PathExists(Dir)
  3413.     or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
  3414.   Result := ForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir);
  3415.  except
  3416.   on EAbort do Result:=False;
  3417.   else raise;
  3418.  end;
  3419. end;
  3420.  
  3421. function StringToVersion(const Str: TString): TFileVersion;
  3422. var
  3423.  S, SH, SL, SR, SB: TString;
  3424.  Code: Integer;
  3425.  Count: Integer;
  3426. begin
  3427.  S:=Str;
  3428.  CleanUp(S, True);
  3429.  S:=ReplaceChar(S, ',','.');
  3430.  Count:=CharCount(S, '.')+1;
  3431.  SH:='0'; SL:='0'; SR:='0'; SB:='0';
  3432.  if Count>=1 then SH:=GetSubStr(S, 1, '.');
  3433.  if Count>=2 then SL:=GetSubStr(S, 2, '.');
  3434.  if Count>=3 then SR:=GetSubStr(S, 3, '.');
  3435.  if Count>=4 then SB:=GetSubStr(S, 4, '.');
  3436.  with Result do begin
  3437.   Val(SH, HiVersion, Code); if Code<>0 then HiVersion:=0;
  3438.   Val(SL, LoVersion, Code); if Code<>0 then LoVersion:=0;
  3439.   Val(SR, Release, Code); if Code<>0 then Release:=0;
  3440.   Val(SB, Build, Code); if Code<>0 then Build:=0;
  3441.  end;
  3442. end;
  3443.  
  3444. function VersionToString(const Ver: TFileVersion): TString;
  3445. begin
  3446.  with Ver do Result:=Format('%d.%d.%d.%d', [HiVersion, LoVersion, Release, Build]);
  3447. end;
  3448.  
  3449. function Version(HiVersion, LoVersion: Integer;
  3450.   Release: Integer = 0; Build: Integer = 0): TFileVersion; overload;
  3451. begin
  3452.  Result.HiVersion:=HiVersion;
  3453.  Result.LoVersion:=LoVersion;
  3454.  Result.Release:=Release;
  3455.  Result.Build:=Build;
  3456. end;
  3457.  
  3458. function LoadResStr(Instance:THandle;ID:Cardinal):TString;
  3459. begin
  3460.  SetLength(Result,512);
  3461.  LoadString(Instance,ID,@Result[1],512);
  3462.  CleanUp(Result);
  3463. end;
  3464.  
  3465. function LoadResStr(ID: Cardinal): TString; overload;
  3466. begin
  3467.  Result:=LoadResStr(hInstance, ID);
  3468. end;
  3469.  
  3470. function LoadDLL(const Path:TString):THandle;
  3471. begin
  3472.  Result:=LoadLibrary(PChar(Path));
  3473. end;
  3474.  
  3475. function GetDLLProc(Handle:THandle;const ProcName:TString):Pointer;
  3476. begin
  3477.  Result:=GetProcAddress(Handle,PChar(ProcName));
  3478. end;
  3479.  
  3480.  
  3481. var
  3482.   OSVersionInfo_Initialized: Boolean = False;
  3483.   OSVersionInfo: TOSVersionInfo;
  3484.  
  3485. procedure Initialize_OSVersionInfo;
  3486. begin
  3487.  if not OSVersionInfo_Initialized then begin
  3488.   ClearMem(OSVersionInfo, SizeOf(OSVersionInfo));
  3489.   OSVersionInfo.dwOSVersionInfoSize:=SizeOf(OSVersionInfo);
  3490.   GetVersionEx(OSVersionInfo);
  3491.   OSVersionInfo_Initialized:=True;
  3492.  end;
  3493. end;
  3494.  
  3495. function _Win32Platform: Integer;
  3496. begin
  3497.  Initialize_OSVersionInfo;
  3498.  Result:=OSVersionInfo.dwPlatformId;
  3499. end;
  3500.  
  3501. function _Win32MajorVersion: Integer;
  3502. begin
  3503.  Initialize_OSVersionInfo;
  3504.  Result:=OSVersionInfo.dwMajorVersion;
  3505. end;
  3506.  
  3507. function _Win32MinorVersion: Integer;
  3508. begin
  3509.  Initialize_OSVersionInfo;
  3510.  Result:=OSVersionInfo.dwMinorVersion;
  3511. end; 
  3512.  
  3513. function WinNT: Boolean;
  3514. begin
  3515.  Result:=_Win32Platform=VER_PLATFORM_WIN32_NT;
  3516. end;
  3517.  
  3518. function Win2K: Boolean;
  3519. begin
  3520.   Result := (_Win32MajorVersion > 4) and (_Win32Platform = VER_PLATFORM_WIN32_NT);
  3521. end;
  3522.  
  3523. function WinME: Boolean;
  3524. begin
  3525.   Result:=(_Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  3526.    ((_Win32MajorVersion>4) or ((_Win32MajorVersion = 4) and (_Win32MinorVersion >= 90)));
  3527. end;
  3528.  
  3529. function WinXP: Boolean;
  3530. begin
  3531.  Result := (_Win32Platform = VER_PLATFORM_WIN32_NT) and
  3532.    ((_Win32MajorVersion)>5) or ((_Win32MajorVersion = 5) and (_Win32MinorVersion >= 1));
  3533. end;
  3534.  
  3535. var
  3536.  GetOperatingSystemFirstCall: Boolean = True;
  3537.  GetOperatingSystemResult: TOperatingSystem;
  3538.  
  3539. function GetOperatingSystem: TOperatingSystem;
  3540. begin
  3541.  if GetOperatingSystemFirstCall then begin
  3542.   GetOperatingSystemResult:=UndefinedWindows;
  3543.   case _Win32Platform of
  3544.    VER_PLATFORM_WIN32S: GetOperatingSystemResult:=Windows3x;
  3545.    VER_PLATFORM_WIN32_WINDOWS: begin
  3546.     if _Win32MajorVersion = 4 then begin
  3547.      if _Win32MinorVersion >= 0 then GetOperatingSystemResult:=Windows95;
  3548.      if _Win32MinorVersion >=10 then GetOperatingSystemResult:=Windows98;
  3549.      if _Win32MinorVersion >=90 then GetOperatingSystemResult:=WindowsME;
  3550.     end;
  3551.    end;
  3552.    VER_PLATFORM_WIN32_NT: begin
  3553.     if _Win32MajorVersion<=4 then GetOperatingSystemResult:=WindowsNT;
  3554.     if _Win32MajorVersion = 5 then begin
  3555.      if _Win32MinorVersion >= 0 then GetOperatingSystemResult:=Windows2000;
  3556.      if _Win32MinorVersion >= 1 then GetOperatingSystemResult:=WindowsXP;
  3557.     end;
  3558.    end;
  3559.   end;
  3560.   GetOperatingSystemFirstCall:=False;
  3561.  end;
  3562.  Result:=GetOperatingSystemResult;
  3563. end;
  3564.  
  3565. procedure Sound(Frequency, Duration: Integer);
  3566. asm
  3567.    push  edx
  3568.    push     eax
  3569.    call  _Win32Platform
  3570.    cmp   eax, VER_PLATFORM_WIN32_NT
  3571.    jne   @@9X
  3572.    call  Windows.Beep
  3573.    ret
  3574. @@9X:
  3575.    pop     eax
  3576.    pop     edx 
  3577.    push  ebx
  3578.    push  edx
  3579.    mov   bx,  ax
  3580.    mov   ax,  34DDh
  3581.    mov   dx,  0012h
  3582.    cmp   dx,  bx
  3583.    jnc   @@2
  3584.    div   bx
  3585.    mov   bx,  ax
  3586.    in    al,  61h
  3587.    test  al,  3
  3588.    jnz   @@1
  3589.    or    al,  3
  3590.    out   61h, al
  3591.    mov   al,  0B6h
  3592.    out   43h, al
  3593. @@1:
  3594.    mov   al,  bl
  3595.    out   42h, al
  3596.    mov   al,  bh
  3597.    out   42h, al
  3598.    call  Windows.Sleep
  3599.    in    al,  61h
  3600.    and   al,  0FCh
  3601.    out   61h, al
  3602.    jmp   @@3
  3603. @@2:
  3604.    pop   edx   
  3605. @@3:
  3606.    pop   ebx
  3607. end;
  3608.  
  3609. procedure CDDoorCmd(Cmd: TString);
  3610. var
  3611.  winmm: HINST;
  3612.  mciSendString: function (lpszCommand: PChar; lpszResturnString: PChar;
  3613.    cchReturn: UINT; hwndCallback: HWND): Integer stdcall;
  3614. begin
  3615.  winmm:=LoadLibrary('winmm.dll');
  3616.  if winmm > 32 then begin
  3617.   mciSendString:=GetProcAddress(winmm, 'mciSendStringA');
  3618.   if Assigned(mciSendString) then
  3619.    mciSendString(PChar(FmtString('SET CDAUDIO DOOR %1 WAIT', [Cmd])),
  3620.     nil, 0, 0);
  3621.   FreeLibrary(winmm);
  3622.  end;
  3623. end;
  3624.  
  3625. procedure OpenCD;
  3626. begin
  3627.  CDDoorCmd('OPEN');
  3628. end;
  3629.  
  3630. procedure CloseCD;
  3631. begin
  3632.  CDDoorCmd('CLOSED');
  3633. end;
  3634.  
  3635. function GetNCFontHandle(const NCFont:TNCFont):cardinal;
  3636. var
  3637.  NCM:TNonClientMetrics;
  3638.  LF:TLogFont;
  3639.  B:LongBool;
  3640. begin
  3641.  NCM.cbSize:=SizeOf(NCM);
  3642.  B:=SystemParametersInfo(SPI_GETNONCLIENTMETRICS,0,@NCM,0);
  3643.  if B then begin
  3644.   case NCFont of
  3645.    SmCaptionFont : LF:=NCM.lfSmCaptionFont;
  3646.    CaptionFont   : LF:=NCM.lfCaptionFont;
  3647.    MenuFont      : LF:=NCM.lfMenuFont;
  3648.    MessageFont   : LF:=NCM.lfMessageFont;
  3649.    StatusFont    : LF:=NCM.lfStatusFont;
  3650.    else            LF:=NCM.lfMessageFont;
  3651.   end;
  3652.   if WinNT then begin
  3653.    LF.lfCharset:=LangIDToCharset(0);
  3654.   end; 
  3655.  end else begin
  3656.   FillChar(LF,SizeOf(LF),0);
  3657.   LF.lfHeight:=-11;
  3658.   LF.lfWidth:=0;
  3659.   LF.lfCharSet:=DEFAULT_CHARSET;
  3660.   StrPCopy(@LF.lfFaceName[0],'MS Sans Serif');
  3661.  end;
  3662.  Result:=CreateFontIndirect(LF);
  3663. end;
  3664.  
  3665. function TrayWnd: HWND;
  3666. begin
  3667.  Result:=FindWindow('Shell_TrayWnd','');
  3668. end;
  3669.  
  3670. function _GetLocale: Integer;
  3671. var
  3672.  Translation: PWord;
  3673.  Buffer: Pointer;
  3674.  Size, Len, Handle: DWORD;
  3675.  Name: TString;
  3676. begin
  3677.  Name:=InstanceName;
  3678.  Size:=GetFileVersionInfoSize(PChar(Name), Handle);
  3679.  if Size = 0 then Result:=GetLocale else begin
  3680.   Buffer:=AllocateMem(Size);
  3681.   try
  3682.    GetFileVersionInfo(PChar(Name), Handle, Size, Buffer);
  3683.    VerQueryValue(Buffer, '\VarFileInfo\Translation', Pointer(Translation), Len);
  3684.    Result:=Translation^;
  3685.   finally
  3686.    DeallocateMem(Buffer);
  3687.   end;
  3688.  end;
  3689. end;
  3690.  
  3691. function LangIDToCharset(LangID: Integer): Byte;
  3692. var I: byte;
  3693. begin
  3694.  Result:=DEFAULT_CHARSET;
  3695.  if LangID = 0 then LangID:=_GetLocale;
  3696.  for i:=0 to LangCount do if Lo(LangID) = LangIDToCharsetInfo[i].LangID then begin
  3697.   Result:=LangIDToCharsetInfo[i].Charset;
  3698.   Break;
  3699.  end;
  3700.  if LangID = $0C1A then Result:=RUSSIAN_CHARSET;
  3701. end;
  3702.  
  3703. procedure OpenShortcut(var FileName: TString);
  3704. var
  3705.  ShellLink: TShellLink;
  3706. begin
  3707.  FileName:=TrimStr(FileName, '"');
  3708.  if EqualText(ExtractFileExt(FileName), '.LNK') then begin
  3709.   ShellLink:=TShellLink.Create;
  3710.   try
  3711.    ShellLink.LoadFromFile(FileName);
  3712.    FileName:=ShellLink.Path;
  3713.   finally
  3714.    ShellLink.Free;
  3715.   end;
  3716.  end;
  3717.  FileName:=GetLongName(FileName);
  3718. end;
  3719.  
  3720. function GetLocale: Integer;
  3721. var
  3722.  DataType: Integer;
  3723.  S: TString;
  3724.  Handle: HKEY;
  3725.  Temp: Integer;
  3726.  Size: Integer;
  3727.  Flag: Boolean;
  3728. begin
  3729.  Result:=GetSystemDefaultLCID;
  3730.  if RegOpenKeyEx(HKEY_CURRENT_USER, 'Control Panel\Desktop\ResourceLocale',
  3731.     0, KEY_READ, Handle)<>ERROR_SUCCESS then Exit;
  3732.  SetString(S, nil, 260);
  3733.  Size:=255;
  3734.  Flag:=RegQueryValueEx(Handle, '', nil, @DataType, PByte(@S[1]), @Size)=ERROR_SUCCESS;
  3735.  RegCloseKey(Handle);
  3736.  if not Flag then Exit;
  3737.  CleanUp(S, True);
  3738.  Temp:=HexToInt(S, DataType);
  3739.  if DataType<>0 then Exit;
  3740.  Result:=Temp;
  3741. end;
  3742.  
  3743. function ExitWindows(uFlags: UINT): BOOL;
  3744. var
  3745.  ProcessHandle: THandle;
  3746.  TokenHandle: THandle;
  3747.  Luid: Int64;
  3748.  Tkp: TTokenPrivileges;
  3749.  BufferNeeded: DWORD;
  3750. begin
  3751.  if WinNT then begin
  3752.   ProcessHandle:=GetCurrentProcess;
  3753.   OpenProcessToken(ProcessHandle, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle);
  3754.   LookupPrivilegeValue(nil, 'SeShutdownPrivilege', Luid);
  3755.   Tkp.PrivilegeCount:=1;
  3756.   Tkp.Privileges[0].Luid:=Luid;
  3757.   Tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  3758.   AdjustTokenPrivileges(TokenHandle, FALSE, Tkp, 0, nil, BufferNeeded);
  3759.  end;
  3760.  Result:=ExitWindowsEx(uFlags, $FFFF);
  3761. end;
  3762.  
  3763. procedure RemoveDirectories(const Path: TString);
  3764. var
  3765.  S: TString;
  3766.  Len, P, i: Integer;
  3767. begin
  3768.  S:=ExcludeTrailingBackslash(Path);
  3769.  repeat
  3770.   if not RemoveDirectory(PChar(S)) then Break;
  3771.   Len:=Length(S);
  3772.   P:=0;
  3773.   for i:=Len downto 0 do if S[i] = '\' then begin
  3774.    P:=i;
  3775.    Break;
  3776.   end;
  3777.   if P = 0 then Break;
  3778.   S:=TrailTrim(S, Len-P+1);
  3779.  until False;
  3780. end;
  3781.  
  3782. function LocalHandle; external kernel32 name 'LocalHandle';
  3783.  
  3784. function AllocateMem(Count: Integer; RecSize: Integer = 1): Pointer;
  3785. asm
  3786.    test  eax, eax
  3787.    jle   @@10
  3788.    test  edx, edx
  3789.    jle   @@10
  3790.    imul  edx
  3791.    push  eax
  3792.    push  LHND
  3793.    call  LocalAlloc
  3794.    push  eax
  3795.    call  LocalLock
  3796.    ret
  3797. @@10:
  3798.    xor   eax, eax
  3799. end;
  3800.  
  3801. procedure ReallocateMem(var Pointer; Count: Integer; RecSize: Integer = 1);
  3802. asm
  3803.    push  ebx
  3804.    mov   ebx, eax
  3805.    mov   eax, [ebx]
  3806.    test  eax, eax
  3807.    jnz   @@10
  3808.    mov   eax, edx
  3809.    mov   edx, ecx
  3810.    call  AllocateMem
  3811.    mov   [ebx], eax
  3812.    pop   ebx
  3813.    ret
  3814. @@10:
  3815.    push  ecx
  3816.    push  edx
  3817.    push  eax
  3818.    call  LocalHandle
  3819.    pop   edx
  3820.    pop   ecx
  3821.    test  eax, eax
  3822.    jnz   @@20
  3823.    pop   ebx
  3824.    ret
  3825. @@20:
  3826.    push  eax
  3827.    mov   eax, edx
  3828.    imul  ecx
  3829.    mov   edx, eax
  3830.    pop   eax
  3831.    push  LHND
  3832.    push  edx
  3833.    push  eax
  3834.    call  LocalRealloc
  3835.    push  eax
  3836.    call  LocalLock
  3837.    mov   [ebx], eax
  3838.    pop   ebx
  3839. end;
  3840.  
  3841. procedure DeallocateMem(var Pointer);
  3842. asm
  3843.    push  ebx
  3844.    mov   ebx, eax
  3845.    mov   eax, [ebx]
  3846.    test  eax, eax
  3847.    jz    @@10
  3848.    push  eax
  3849.    call  LocalHandle
  3850.    test  eax, eax
  3851.    jz    @@10
  3852.    push  eax
  3853.    push  eax
  3854.    call  LocalUnlock
  3855.    call  LocalFree
  3856. @@10:
  3857.    xor   eax, eax
  3858.    mov   [ebx], eax
  3859.    pop   ebx
  3860. end;
  3861.  
  3862. function MemSize(P: Pointer): Integer;
  3863. asm
  3864.    test  eax, eax
  3865.    jnz   @@10
  3866.    ret
  3867. @@10:
  3868.    push  eax
  3869.    call  LocalHandle
  3870.    test  eax, eax
  3871.    jnz   @@20
  3872.    ret
  3873. @@20:
  3874.    push  eax
  3875.    call  LocalSize
  3876. end;
  3877.  
  3878. function Year:word;
  3879. var
  3880.  S:TSystemTime;
  3881. begin
  3882.  GetLocalTime(S);
  3883.  Result:=S.wYear;
  3884. end;
  3885.  
  3886. function Month:word;
  3887. var
  3888.  S:TSystemTime;
  3889. begin
  3890.  GetLocalTime(S);
  3891.  Result:=S.wMonth;
  3892. end;
  3893.  
  3894. function Day:word;
  3895. var
  3896.  S:TSystemTime;
  3897. begin
  3898.  GetLocalTime(S);
  3899.  Result:=S.wDay;
  3900. end;
  3901.  
  3902. function DayOfWeek:word;
  3903. var
  3904.  S:TSystemTime;
  3905. begin
  3906.  GetLocalTime(S);
  3907.  Result:=S.wDayOfWeek;
  3908. end;
  3909.  
  3910. function Hour:word;
  3911. var
  3912.  S:TSystemTime;
  3913. begin
  3914.  GetLocalTime(S);
  3915.  Result:=S.wHour;
  3916. end;
  3917.  
  3918. function Minute:word;
  3919. var
  3920.  S:TSystemTime;
  3921. begin
  3922.  GetLocalTime(S);
  3923.  Result:=S.wMinute;
  3924. end;
  3925.  
  3926. function Second:word;
  3927. var
  3928.  S:TSystemTime;
  3929. begin
  3930.  GetLocalTime(S);
  3931.  Result:=S.wSecond;
  3932. end;
  3933.  
  3934. function Milliseconds:word;
  3935. var
  3936.  S:TSystemTime;
  3937. begin
  3938.  GetLocalTime(S);
  3939.  Result:=S.wMilliseconds;
  3940. end;
  3941.  
  3942. function Timer:Integer;
  3943. var
  3944.  S:TSystemTime;
  3945. begin
  3946.  GetLocalTime(S);
  3947.  with S do Result:=wHour*3600000+wMinute*60000+wSecond*1000+wMilliseconds;
  3948. end;
  3949.  
  3950. function LeapYear(Year:Word):Boolean;
  3951. begin
  3952.  if Year mod 100<>0 then Result:=(Year mod 4=0)
  3953.                     else Result:=((Year div 100) mod 4=0);
  3954. end;
  3955.  
  3956. function MonthLength(Month,Year:Word):Word; overload;
  3957. const Data:array[1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31);
  3958. begin
  3959.  Result:=Data[Month];
  3960.  if (Month=2) and LeapYear(Year) then Inc(Result);
  3961. end;
  3962.  
  3963. function MonthLength: Word; overload;
  3964. var
  3965.  L: TSystemTime;
  3966. begin
  3967.  GetLocalTime(L);
  3968.  Result:=MonthLength(L.wMonth, L.wYear);
  3969. end;  
  3970.  
  3971. procedure GetLogicalDriveList(const List: TStrings);
  3972. var
  3973.  Size, Pos: Cardinal;
  3974.  Buffer: array[0..127] of AnsiChar;
  3975.  P: PChar;
  3976. begin
  3977.  List.BeginUpdate;
  3978.  try
  3979.   List.Clear;
  3980.   Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);
  3981.   Pos:=0;
  3982.   while Pos<Size do begin
  3983.    P:=@Buffer[Pos];
  3984.    List.Add(P);
  3985.    while Buffer[Pos]<>#0 do Inc(Pos);
  3986.    Inc(Pos);
  3987.   end;
  3988.  finally
  3989.   List.EndUpdate;
  3990.  end;
  3991. end;
  3992.  
  3993. procedure GetFixedDriveList(const List: TStrings);
  3994. var
  3995.  Size, Pos: Cardinal;
  3996.  Buffer: array[0..127] of AnsiChar;
  3997.  P: PChar;
  3998. begin
  3999.  List.BeginUpdate;
  4000.  try
  4001.   List.Clear;
  4002.   Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);
  4003.   Pos:=0;
  4004.   while Pos<Size do begin
  4005.    P:=@Buffer[Pos];
  4006.    if GetDriveType(P) = DRIVE_FIXED then List.Add(P);
  4007.    while Buffer[Pos]<>#0 do Inc(Pos);
  4008.    Inc(Pos);
  4009.   end;
  4010.  finally
  4011.   List.EndUpdate;
  4012.  end;
  4013. end;
  4014.  
  4015. function ChangeLayout(LANG: Integer): Boolean;
  4016. var
  4017.  Layouts: array [0..16] of HKL;
  4018.  i, Count: Integer;
  4019. begin
  4020.  Result:=False;
  4021.  Count:=GetKeyboardLayoutList(High(Layouts)+1, Layouts)-1;
  4022.  for i:=0 to Count do if (LoWord(Layouts[i]) and $FF) = LANG then
  4023.   Result:=ActivateKeyboardLayout(Layouts[i], 0)<>0;
  4024. end;
  4025.  
  4026.  
  4027. function GetStringFileInfo(const FileName: TString; const Key: TString):TString;
  4028. var
  4029.  Translation: PLongInt;
  4030.  W: PWord absolute Translation;
  4031.  Buffer, Value: Pointer;
  4032.  Size, Len, Handle: DWORD;
  4033.  Name, SFI, Lang: TString;
  4034.  P: PChar;
  4035. begin
  4036.  Name:=FileName; CleanUp(Name, True);
  4037.  if IsEmptyStr(Name) then Name:=InstanceName;
  4038.  P:=PChar(Name);
  4039.  Size:=GetFileVersionInfoSize(P, Handle);
  4040.  if Size<>0 then begin
  4041.   Buffer:=AllocateMem(Size);
  4042.   if Buffer = nil then OutOfMemoryError;
  4043.   try
  4044.    GetFileVersionInfo(P, Handle, Size, Buffer);
  4045.    VerQueryValue(Buffer, '\VarFileInfo\Translation', Pointer(Translation), Len);
  4046.    if EqualText(Key, sfiLanguageName) then begin
  4047.     VerLanguageName(W^, Buffer, Size);
  4048.     Result:=PChar(Buffer);
  4049.    end else if EqualText(Key, sfiLanguageID) then begin
  4050.     Result:=IntToStr(W^);
  4051.    end else begin
  4052.     Lang:=IntToHex(SwapWords(Translation^), 8);
  4053.     SFI:=Format('\StringFileInfo\%s\%s', [Lang, Key]);
  4054.     VerQueryValue(Buffer, PChar(SFI), Value, Len);
  4055.     Result:=PChar(Value);
  4056.    end;
  4057.   finally
  4058.    DeallocateMem(Buffer);
  4059.   end;
  4060.  end else Result:='';
  4061. end;
  4062.  
  4063. function GetShortName(const FileName:TString):TString;
  4064. begin
  4065.  if FileExists(FileName) then begin
  4066.   SetLength(Result,128);
  4067.   GetShortPathName(PChar(FileName),@Result[1],128);
  4068.   CleanUp(Result);
  4069.  end else Result:=FileName;
  4070. end;
  4071.  
  4072. procedure LoadFile(const FileName: TString; out Buffer: Pointer; out Size: Integer);
  4073. var
  4074.  F: TFile;
  4075. begin
  4076.  F:=TFile.Open(FileName);
  4077.  try
  4078.   Size:=F.Size;
  4079.   Buffer:=AllocateMem(Size);
  4080.   try
  4081.    F.Read(Buffer^, Size);
  4082.   except
  4083.    DeallocateMem(Buffer);
  4084.    raise;
  4085.   end;
  4086.  finally
  4087.   F.Close;
  4088.  end;
  4089. end;
  4090.  
  4091. procedure SaveFile(const FileName: TString; Buffer: Pointer; Size: Integer);
  4092. var
  4093.  F: TFile;
  4094. begin
  4095.  F:=TFile.Create(FileName, False);
  4096.  try
  4097.   F.Write(Buffer^, Size);
  4098.  finally
  4099.   F.Close;
  4100.  end;
  4101. end;
  4102.  
  4103.  
  4104. function _GetLongName(FileName:TString):TString;
  4105. var
  4106.  SR:TSearchRec;
  4107.  Res:Cardinal;
  4108.  Path:TString;
  4109.  S1,S2,SN:TString;
  4110. begin
  4111.  CleanUp(FileName, True);
  4112.  if IsEmptyStr(FileName) then begin
  4113.   Result:='';
  4114.   Exit;
  4115.  end; 
  4116.  if not FileExists(FileName) then begin
  4117.   if not PathExists(FileName) then begin
  4118.    Result:=FileName;
  4119.    Exit;
  4120.   end;
  4121.  end;
  4122.  Path:=ExtractFilePath(FileName)+'*.*';
  4123.  S1:=FileName;
  4124.  Delete(S1, 1, 1);
  4125.  if (Path<>'') and (S1<>':') and (S1<>'\') then begin
  4126.   Res:=FindFirst(Path,faAnyFile,SR);
  4127.   Result:=FileName;
  4128.   SN:=ExtractFileName(FileName);
  4129.   while Res=0 do begin
  4130.    S2:=SR.Name;
  4131.    if MatchString(SN, [SR.FindData.cAlternateFileName,S2])<>0 then begin
  4132.     Result:=_GetLongName(TrailTrim(Path,4))+'\'+S2;
  4133.     Break;
  4134.    end;
  4135.    Res:=FindNext(SR);
  4136.   end
  4137.  end else Result:=FileName;
  4138.  FindClose(SR);
  4139. end;
  4140.  
  4141. function GetLongName(const FileName:TString):TString;
  4142. var
  4143.  GetLongPathName:function (pszShortName:PChar;pszLongName:PChar;
  4144.                            cchBuffer:Integer):Integer stdcall;
  4145.  Handle:hInst;
  4146. begin
  4147.  Handle:=GetModuleHandle('kernel32.dll');
  4148.  @GetLongPathName:=GetProcAddress(Handle,'GetLongPathNameA');
  4149.  if Assigned(GetLongPathName) then begin
  4150.   SetLength(Result,261);
  4151.   if GetLongPathName(PChar(FileName),PChar(Result),260)<>0 then CleanUp(Result)
  4152.                                                            else Result:=FileName;
  4153.  end else Result:=_GetLongName(FileName);
  4154. end;
  4155.  
  4156. function GetUserName: TString;
  4157. var
  4158.  N: Cardinal;
  4159.  Buf: array[0..1023] of AnsiChar;
  4160. begin
  4161.  N:=SizeOf(Buf)-1;
  4162.  Windows.GetUserName(Buf, N);
  4163.  Result:=PChar(@Buf[0]);
  4164. end;
  4165.  
  4166. function GetComputerName: TString;
  4167. var
  4168.  N: Cardinal;
  4169.  Buf: array [0..MAX_COMPUTERNAME_LENGTH + 1] of AnsiChar;
  4170. begin
  4171.  N:=SizeOf(Buf)-1;
  4172.  Windows.GetComputerName(Buf, N);
  4173.  Result:=PChar(@Buf[0]);
  4174. end;
  4175.  
  4176. function PathExists(const Path:TString): Boolean;
  4177. var
  4178.   Code: Integer;
  4179. begin
  4180.   Code := GetFileAttributes(PChar(Path));
  4181.   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
  4182. end;
  4183.  
  4184. function ExtractFolderName(const FileName: TString): TString;
  4185. var
  4186.  P1, P2: Integer;
  4187. begin
  4188.  P2:=FindChars(FileName, ['\'], Length(FileName), -1);
  4189.  if P2 = 0 then P2:=Length(FileName);
  4190.  P1:=FindChars(FileName, ['\'], P2-1, -1);
  4191.  Result:=ReadSubStr(FileName, P1+1, P2-1);
  4192. end;
  4193.  
  4194. function ChangeFileExt(const FileName, NewExt: TString): TString;
  4195. var
  4196.  P: Integer;
  4197.  Name, Ext: TString;
  4198. begin
  4199.  Name:=PChar(@FileName[1]);
  4200.  Ext:=PChar(@NewExt[1]);
  4201.  CleanUp(Ext, True);
  4202.  Ext:=LeftTrim(Ext, chPoint);
  4203.  P:=FindChars(Name, [chPoint], Length(Name), -1);
  4204.  if P = 0 then Result:=Name+chPoint+Ext
  4205.           else Result:=Copy(Name, 1, P)+Ext;
  4206. end;
  4207.  
  4208. function CompareVersion(const Version1, Version2: TFileVersion): Integer;
  4209. asm
  4210.    mov   ecx, [eax].TFileVersion.HiVersion
  4211.    cmp   ecx, [edx].TFileVersion.HiVersion
  4212.    jg    @@10
  4213.    jl    @@20
  4214.    mov   ecx, [eax].TFileVersion.LoVersion
  4215.    cmp   ecx, [edx].TFileVersion.LoVersion
  4216.    jg    @@10
  4217.    jl    @@20
  4218.    mov   ecx, [eax].TFileVersion.Release
  4219.    cmp   ecx, [edx].TFileVersion.Release
  4220.    jg    @@10
  4221.    jl    @@20
  4222.    mov   ecx, [eax].TFileVersion.Build
  4223.    cmp   ecx, [edx].TFileVersion.Build
  4224.    jg    @@10
  4225.    jl    @@20
  4226.    xor   eax, eax
  4227.    ret
  4228. @@10:
  4229.    xor   eax, eax
  4230.    inc   eax
  4231.    ret
  4232. @@20:
  4233.    xor   eax, eax
  4234.    dec   eax
  4235.    ret
  4236. end;
  4237.  
  4238. function GetFileName(const FileName:TString):TString;
  4239. begin
  4240.  Result:=TrailTrim(ExtractFileName(FileName),Length(ExtractFileExt(FileName)));
  4241. end;
  4242.  
  4243. function GetDiskFreeSize(Dir: TString): Int64;
  4244. var
  4245.  GetDiskFreeSpaceEx: function(Root: PChar; FBA, TNB, TNFB: PInt64): BOOL stdcall;
  4246.  GetDiskFreeSpace: function(Root: PChar; SPC, BPS, NFC, TNC: LPDWORD): BOOL stdcall;
  4247.  Handle: HINST;
  4248.  Dummy: Int64;
  4249.  SPC, BPS, NFC: DWORD;
  4250. begin
  4251.  Handle:=GetModuleHandle('kernel32.dll');
  4252.  GetDiskFreeSpaceEx:=GetProcAddress(Handle, 'GetDiskFreeSpaceExA');
  4253.  if Assigned(GetDiskFreeSpaceEx) then begin
  4254.   if not GetDiskFreeSpaceEx(PChar(Dir), @Result, @Dummy, @Dummy) then Result:=-1;
  4255.  end else begin
  4256.   GetDiskFreeSpace:=GetProcAddress(Handle, 'GetDiskFreeSpaceA');
  4257.   if Assigned(GetDiskFreeSpace) and
  4258.   GetDiskFreeSpace(PChar(Dir), @SPC, @BPS, @NFC, PDWORD(@Dummy))
  4259.    then Result:=SPC*BPS*NFC else Result:=-1;
  4260.  end;
  4261. end;
  4262.  
  4263.  
  4264. function GetColor(Color: Integer): Integer; register;
  4265. asm
  4266.    cmp   eax, 0
  4267.    jge   @@10
  4268.    and   eax, 000000FFH
  4269.    push  eax
  4270.    call  GetSysColor
  4271. @@10:
  4272. end;
  4273.  
  4274. function GetColor(Red, Green, Blue: Integer): Integer; register;
  4275. asm
  4276.    and   eax, 0FFh
  4277.    and   edx, 0FFh
  4278.    and   ecx, 0FFh
  4279.    shl   edx, 8
  4280.    shl   ecx, 16
  4281.    or    eax, ecx
  4282.    or    eax, edx
  4283. end;
  4284.  
  4285. procedure IndexToRGB(Color: Integer; R, G, B : PByte);
  4286. asm
  4287.    push ebx
  4288.    mov  ebx, b
  4289.    test edx, edx
  4290.    jz   @@GREEN
  4291.    mov  [edx], al
  4292. @@GREEN:
  4293.    shr  eax, 8
  4294.    test ecx, ecx
  4295.    jz   @@BLUE
  4296.    mov  [ecx], al
  4297. @@BLUE:
  4298.    shr eax, 8
  4299.    test ebx, ebx
  4300.    jz   @@QUIT
  4301.    mov  [ebx], al
  4302. @@QUIT:
  4303.    pop ebx
  4304. end;
  4305.  
  4306.  
  4307. procedure Line(DC: HDC; X1, Y1, X2, Y2: Integer);
  4308. begin
  4309.  MoveToEx(DC, X1, Y1, nil);
  4310.  LineTo(DC, X2, Y2);
  4311. end;
  4312.  
  4313. function clGradientActiveCaption: Integer;
  4314. var
  4315.  B: BOOL;
  4316. begin
  4317.  SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @B, 0);
  4318.  if B then Result:=GetSysColor(COLOR_GRADIENTACTIVECAPTION)
  4319.   else Result:=GetSysColor(COLOR_ACTIVECAPTION);
  4320. end;
  4321.  
  4322.  
  4323. function ValueToName(Value:Integer;Map:array of TIdentMapItem; Default: TString = ''):TString;
  4324. var i:Integer;
  4325. begin
  4326.  Result:=Default;
  4327.  for i:=Low(Map) to High(Map) do if Map[i].Value=Value then begin
  4328.   Result:=Map[i].Name;
  4329.   Break;
  4330.  end;
  4331. end;
  4332.  
  4333. function NameToValue(Name:TString;Map:array of TIdentMapItem; Default: Integer = 0):Integer;
  4334. var i:Integer;
  4335. begin
  4336.  Result:=Default;
  4337.  for i:=Low(Map) to High(Map) do if Map[i].Name=Name then begin
  4338.   Result:=Map[i].Value;
  4339.   Break;
  4340.  end;
  4341. end;
  4342.  
  4343. const
  4344.  NPUControl   : word = $1C3F;
  4345.  NPUCtrlRound : word = $133F;
  4346.  NPUCtrlFloor : word = $143F;
  4347.  NPUCtrlCeil  : word = $183F;
  4348.  SaveNPUCtrl  : word = $0000;
  4349.  
  4350. function Int(R: Extended):Extended;
  4351. asm
  4352.   fclex
  4353.   fstcw   SaveNPUCtrl
  4354.   fldcw   NPUControl
  4355.   fld     R
  4356.   frndint
  4357.   fwait
  4358.   fldcw   SaveNPUCtrl
  4359. end;
  4360.  
  4361. function Frac(R:Extended):Extended;
  4362. begin
  4363.  Result:=R-Int(R);
  4364. end;
  4365.  
  4366. function Trunc(R:Extended):Integer;
  4367. var
  4368.  ERX: LongInt;
  4369. asm
  4370.   fclex
  4371.   fstcw SaveNPUCtrl
  4372.   fldcw NPUControl
  4373.   fld   R
  4374.   fistp dword ptr ERX
  4375.   fwait
  4376.   fldcw SaveNPUCtrl
  4377.   mov   eax, ERX
  4378. end;
  4379.  
  4380. function Round(R:Extended):Integer;
  4381. var
  4382.   ERX: LongInt;
  4383. asm
  4384.   fclex
  4385.   fstcw SaveNPUCtrl
  4386.   fldcw NPUCtrlRound
  4387.   fld   R
  4388.   fistp dword ptr ERX
  4389.   fwait
  4390.   fldcw SaveNPUCtrl
  4391.   mov   eax, ERX
  4392. end;
  4393.  
  4394. function Floor(R:Extended):Extended;
  4395. asm
  4396.   fclex
  4397.   fstcw   SaveNPUCtrl
  4398.   fldcw   NPUCtrlFloor
  4399.   fld     R
  4400.   frndint
  4401.   fwait
  4402.   fldcw   SaveNPUCtrl
  4403. end;
  4404.  
  4405. function Ceil(R:Extended):Extended;
  4406. asm
  4407.   fclex
  4408.   fstcw   SaveNPUCtrl
  4409.   fldcw   NPUCtrlCeil
  4410.   fld     R
  4411.   frndint
  4412.   fwait
  4413.   fldcw   SaveNPUCtrl
  4414. end;
  4415.  
  4416. function Arctan2(X, Y: Extended): Extended;
  4417. asm
  4418.         FLD     X
  4419.         FLD     Y
  4420.         FPATAN
  4421.         FWAIT
  4422. end;
  4423.  
  4424. procedure ClearFPUEx;
  4425. asm
  4426.    FCLEX
  4427. end;
  4428.  
  4429. function Infinity(R:Extended):Integer;
  4430. var
  4431.  P:^cardinal;
  4432.  N:Integer;
  4433. begin
  4434.  N:=Integer(@R)+6;
  4435.  P:=Pointer(N);
  4436.  case P^ of
  4437.   $7FFF8000:Result:=1;
  4438.   $FFFF8000:Result:=-1;
  4439.   else Result:=0;
  4440.  end;
  4441. end;
  4442.  
  4443. function NonAtNumber(R:Extended):Boolean;
  4444. var
  4445.  P:^cardinal;
  4446.  N:Integer;
  4447. begin
  4448.  N:=Integer(@R)+6;
  4449.  P:=Pointer(N);
  4450.  PByte(P)^:=0;
  4451.  Result:=P^=$FFFFC000;
  4452. end;
  4453.  
  4454. function LoadTextFile(const FileName:TString; var Text:TString):Integer;
  4455. var
  4456.  F: File;
  4457.  Count:Integer;
  4458. begin
  4459.  {$I-}
  4460.  AssignFile(F,FileName); Reset(F,1);
  4461.  Count:=FileSize(F)+10;
  4462.  Setlength(Text, Count);
  4463.  BlockRead(F, PChar(Text)^, Count);
  4464.  CleanUp(Text);
  4465.  CloseFile(F);
  4466.  {$I+}
  4467.  Result:=IOResult;
  4468. end;
  4469.  
  4470. function SaveTextFile(const FileName, Text: TString):Integer;
  4471. var
  4472.  F:File;
  4473.  Count:Integer;
  4474. begin
  4475.  {$I-}
  4476.  AssignFile(F,FileName); Rewrite(F,1);
  4477.  Count:=Length(Text);
  4478.  BlockWrite(F, PChar(Text)^, Count);
  4479.  CloseFile(F);
  4480.  {$I+}
  4481.  Result:=IOResult;
  4482. end;
  4483.  
  4484. function Incr(var N:Integer):Integer; register;
  4485. asm
  4486.    mov  edx, [eax]
  4487.    inc  edx
  4488.    mov  [eax], edx
  4489.    mov  eax, edx
  4490. end;
  4491.  
  4492. function Decr(var N:Integer):Integer; register;
  4493. asm
  4494.    mov  edx, [eax]
  4495.    dec  edx
  4496.    mov  [eax], edx
  4497.    mov  eax, edx
  4498. end;
  4499.  
  4500. function HiLong(const N: TWideInt): LongInt;
  4501. asm
  4502.    mov   eax, [eax+4]
  4503. end;
  4504.  
  4505. function LoLong(const N: TWideInt): LongInt;
  4506. asm
  4507.    mov   eax, [eax]
  4508. end;
  4509.  
  4510. function HiWord(N: Integer): word;
  4511. asm
  4512.    shr   eax, 16
  4513. end;
  4514.  
  4515. function LoWord(N: Integer): word;
  4516. asm
  4517.    and   eax, 0FFFFh;
  4518. end;
  4519.  
  4520. function HiByte(W: Word): Byte;
  4521. asm
  4522.    shr   ax, 8
  4523. end;
  4524.  
  4525. function LoByte(W: Word): Byte;
  4526. asm
  4527.    and   ax, 0FFh
  4528. end;
  4529.  
  4530. function AbsSub(N1, N2: Integer): Integer;
  4531. asm
  4532.    sub   eax, edx
  4533.    test  eax, eax
  4534.    jl    @@10
  4535.    ret
  4536. @@10:
  4537.    neg   eax
  4538. end;
  4539.  
  4540. function Bit(Value, Index: Integer): Boolean;
  4541. asm
  4542.    bt    eax, edx
  4543.    setc  al
  4544.    and   eax, 0FFh
  4545. end;
  4546.  
  4547.  
  4548. function SwapWords(Value: Integer): Integer;
  4549. asm
  4550.    mov   ecx, eax
  4551.    shl   ecx, 16
  4552.    shr   eax, 16
  4553.    or    eax, ecx
  4554. end;
  4555.  
  4556. function AbsInt(Value: Integer): Integer;
  4557. asm
  4558.    test  eax, eax
  4559.    jl    @@10
  4560.    ret
  4561. @@10:
  4562.    neg   eax
  4563. end;
  4564.  
  4565. function GetAddress: Pointer;
  4566. asm
  4567.    mov   eax, [esp]
  4568.    add   eax, -5
  4569. end;
  4570.  
  4571. procedure MoveMem(const Source; var Dest; Count: Integer);
  4572. asm
  4573.    push  esi
  4574.    push  edi
  4575.    mov   esi, eax
  4576.    mov   edi, edx
  4577.    mov   eax, ecx
  4578.    cmp   edi, esi
  4579.    ja    @@10
  4580.    je    @@20
  4581.    sar   ecx, 2
  4582.    js    @@20
  4583.    rep   movsd
  4584.    mov   ecx, eax
  4585.    and   ecx, 3
  4586.    rep   movsb
  4587.    jmp   @@20
  4588. @@10:
  4589.    lea   esi, [esi+ecx-4]
  4590.    lea   edi, [edi+ecx-4]
  4591.    sar   ecx, 2
  4592.    js    @@20
  4593.    std
  4594.    rep   movsd
  4595.    mov   ecx, eax
  4596.    and   ecx, 3
  4597.    add   esi, 3
  4598.    add   edi, 3
  4599.    rep   movsb
  4600.    cld
  4601. @@20:
  4602.    pop   edi
  4603.    pop   esi
  4604. end;
  4605.  
  4606. procedure InvertMem(var X; Size:Integer=1);
  4607. asm
  4608.    push   esi
  4609.    mov    esi, eax
  4610.    mov    eax, edx
  4611.    sar    edx, 2
  4612. @@10:
  4613.    test   edx, edx
  4614.    jz     @@20
  4615.    mov    ecx, [esi]
  4616.    not    ecx
  4617.    mov    [esi], ecx
  4618.    add    esi, 4
  4619.    dec    edx
  4620.    jmp    @@10
  4621. @@20:
  4622.    mov    edx, eax
  4623.    and    edx, 3
  4624. @@30:
  4625.    test   edx, edx
  4626.    jz     @@40
  4627.    mov    cl, [esi]
  4628.    not    cl
  4629.    mov    [esi], cl
  4630.    inc    esi
  4631.    dec    edx
  4632.    jmp    @@30
  4633. @@40:
  4634.    pop    esi
  4635. end;
  4636.  
  4637. procedure XorMem(var X; Size: Integer; Value: Byte);
  4638. asm
  4639.    test   edx, edx
  4640.    jz     @@10
  4641.    xor    [eax], cl
  4642.    inc    eax
  4643.    dec    edx
  4644.    jmp    XorMem
  4645. @@10:
  4646. end;
  4647.  
  4648. procedure XorMemW(var X; Count: Integer; Value: Word);
  4649. asm
  4650.    test   edx, edx
  4651.    jz     @@10
  4652.    xor    [eax], cx
  4653.    add    eax, 2
  4654.    dec    edx
  4655.    jmp    XorMemW
  4656. @@10:
  4657. end;
  4658.  
  4659. procedure XorMemL(var X; Count: Integer; Value: LongInt);
  4660. asm
  4661.    test   edx, edx
  4662.    jz     @@10
  4663.    xor    [eax], ecx
  4664.    add    eax, 4
  4665.    dec    edx
  4666.    jmp    XorMemL
  4667. @@10:
  4668. end;
  4669.  
  4670. procedure FillMem(var X; Size: Integer; Value: Byte = 0);
  4671. asm
  4672.    push   edi
  4673.    mov    edi, eax
  4674.    mov    ch, cl
  4675.    mov    ax, cx
  4676.    shl    eax, 16
  4677.    mov    ax, cx
  4678.    mov    ecx, edx
  4679.    sar    ecx, 2
  4680.    rep    stosd
  4681.    mov    ecx, edx
  4682.    and    ecx, 3
  4683.    rep    stosb
  4684.    pop    edi
  4685. end;
  4686.  
  4687. procedure FillMemW(var X; Count: Integer; Value: Word = 0);
  4688. asm
  4689.    push   edi
  4690.    mov    edi, eax
  4691.    mov    ax, cx
  4692.    mov    ecx, edx
  4693.    rep    stosw
  4694.    pop    edi
  4695. end;
  4696.  
  4697. procedure FillMemL(var X; Count: Integer; Value: LongInt = 0);
  4698. asm
  4699.    push   edi
  4700.    mov    edi, eax
  4701.    mov    eax, ecx
  4702.    mov    ecx, edx
  4703.    rep    stosd
  4704.    pop    edi
  4705. end;
  4706.  
  4707. procedure ClearMem(var X; Size: Integer);
  4708. asm
  4709.    push   edi
  4710.    mov    edi, eax
  4711.    xor    eax, eax
  4712.    mov    ecx, edx
  4713.    sar    ecx, 2
  4714.    rep    stosd
  4715.    mov    ecx, edx
  4716.    and    ecx, 3
  4717.    rep    stosb
  4718.    pop    edi
  4719. end;
  4720.  
  4721. function GetLength(const Str: TString): Integer; register;
  4722. asm
  4723.    test  eax, eax
  4724.    jz    @@20
  4725.    mov   edx, eax
  4726.    dec   eax
  4727. @@10:
  4728.    inc   eax
  4729.    mov   cl, [eax]
  4730.    test  cl, cl
  4731.    jnz   @@10
  4732.    sub   eax, edx
  4733. @@20:
  4734. end;
  4735.  
  4736. function GetStrLen(const Str: TString): Integer;
  4737. asm
  4738.    test  eax, eax
  4739.    jz    @@10
  4740.    mov   eax, [eax-4]
  4741. @@10:
  4742. end;
  4743.  
  4744. function IsEmptyStr(const Str: TString): LongBool; register;
  4745. asm
  4746.    test  eax, eax
  4747.    jz    @@10
  4748.    mov   al, [eax]
  4749.    test  al, al
  4750.    setz  al
  4751.    and   eax, 0FFh
  4752.    ret
  4753. @@10:
  4754.    inc   al
  4755. end;
  4756.  
  4757. function CharEntryPos(const Str: TString; Ch: Char; Entry: Integer): Integer; register;
  4758. asm
  4759.    push  edi
  4760.    push  esi
  4761.    test  eax, eax
  4762.    jnz   @@10
  4763.    xor   eax, eax
  4764.    jmp   @@50
  4765. @@10:
  4766.    cmp   ecx, 0
  4767.    jnz   @@20
  4768.    xor   eax, eax
  4769.    jmp   @@50
  4770. @@20:
  4771.    mov   edi, eax
  4772.    dec   edi
  4773.    xor   esi, esi
  4774. @@30:
  4775.    inc   edi
  4776.    mov   dh, [edi]
  4777.    test  dh, dh
  4778.    jnz   @@40
  4779.    xor   eax, eax
  4780.    jmp   @@50
  4781. @@40:
  4782.    cmp   dh, dl
  4783.    jne   @@30
  4784.    inc   esi
  4785.    cmp   esi, ecx
  4786.    jne   @@30
  4787.    sub   edi, eax
  4788.    mov   eax, edi
  4789.    inc   eax
  4790. @@50:
  4791.    pop   esi
  4792.    pop   edi
  4793. end;
  4794.  
  4795. procedure ReplaceText(const SubStr: TString; var Str: TString; Pos, Len: Integer);
  4796. begin
  4797.  Delete(Str, Pos, Len);
  4798.  Insert(SubStr, Str, Pos);
  4799. end;
  4800.  
  4801. function EqualText(const S1, S2: TString): LongBool;
  4802. var
  4803.    Nullum: LongInt;
  4804. asm
  4805.    xor   ecx, ecx
  4806.    mov   Nullum, ecx
  4807.    test  edx, edx
  4808.    jz    @@10
  4809.    mov   ecx, [edx-4]
  4810.    jmp   @@20
  4811. @@10:
  4812.    lea   edx, Nullum
  4813. @@20:
  4814.    push  ecx
  4815.    push  edx
  4816.    xor   ecx, ecx
  4817.    test  eax, eax
  4818.    jz    @@30
  4819.    mov   ecx, [eax-4]
  4820.    jmp   @@40
  4821. @@30:
  4822.    lea   eax, Nullum
  4823. @@40:   
  4824.    push  ecx
  4825.    push  eax
  4826.    push  NORM_IGNORECASE
  4827.    push  LOCALE_USER_DEFAULT
  4828.    call  CompareString
  4829.    cmp   eax, 2
  4830.    setz  al
  4831.    and   eax, 0FFh
  4832. end;
  4833.  
  4834. function EqualStr(const S1, S2: TString): LongBool;
  4835. var
  4836.    Nullum: LongInt;
  4837. asm
  4838.    xor   ecx, ecx
  4839.    mov   Nullum, ecx
  4840.    test  edx, edx
  4841.    jz    @@10
  4842.    mov   ecx, [edx-4]
  4843.    jmp   @@20
  4844. @@10:
  4845.    lea   edx, Nullum
  4846. @@20:
  4847.    push  ecx
  4848.    push  edx
  4849.    xor   ecx, ecx
  4850.    test  eax, eax
  4851.    jz    @@30
  4852.    mov   ecx, [eax-4]
  4853.    jmp   @@40
  4854. @@30:
  4855.    lea   eax, Nullum
  4856. @@40:   
  4857.    push  ecx
  4858.    push  eax
  4859.    push  0
  4860.    push  LOCALE_USER_DEFAULT
  4861.    call  CompareString
  4862.    cmp   eax, 2
  4863.    setz  al
  4864.    and   eax, 0FFh
  4865. end;
  4866.  
  4867. function IntToStrLen(N: Integer; Len: Integer = 0): TString;
  4868. begin
  4869.  Result:=IntToStr(N);
  4870.  if GetStrLen(Result)<Len then Result:=FillString('0',Len-GetStrLen(Result))+Result;
  4871. end;
  4872.  
  4873. function GetPos(const SubStr, Str: TString; CaseSensitive: LongBool = True): Integer;
  4874. var
  4875.   PTX, CSX: Integer;
  4876. asm
  4877.    push  esi
  4878.    push  edi
  4879.    push  ebx
  4880.    test  eax, eax
  4881.    jz    @@20
  4882.    test  edx, edx
  4883.    jz    @@20
  4884.    mov   esi, eax
  4885.    mov   edi, edx
  4886.    mov   ptx, edx
  4887.    mov   ebx, [esi-4]
  4888.    not   ecx
  4889.    and   ecx, 1
  4890.    mov   CSX, ecx
  4891.    dec   edi
  4892. @@10:
  4893.    inc   edi
  4894.    mov   al, [edi]
  4895.    test  al, al
  4896.    jz    @@20
  4897.    push  ebx
  4898.    push  esi
  4899.    push  ebx
  4900.    push  edi
  4901.    push  csx
  4902.    push  LOCALE_USER_DEFAULT
  4903.    call  CompareString
  4904.    cmp   eax, 2
  4905.    jne   @@10
  4906.    mov   eax, edi
  4907.    sub   eax, ptx
  4908.    inc   eax
  4909.    jmp   @@30
  4910. @@20:
  4911.    xor   eax, eax
  4912. @@30:
  4913.    pop   ebx
  4914.    pop   edi
  4915.    pop   esi
  4916. end;
  4917.  
  4918. function GUIDToString(const GUID: TGUID): TString;
  4919. var
  4920.  S1, S2, S3: TString;
  4921.  S401: TString;
  4922.  S427: TString;
  4923.  i: Integer;
  4924. begin
  4925.  S1:=IntToHex(GUID.D1, 8);
  4926.  S2:=IntToHex(GUID.D2, 4);
  4927.  S3:=IntToHex(GUID.D3, 4);
  4928.  S401:=IntToHex(GUID.D4[0], 2)+IntToHex(GUID.D4[1], 2);
  4929.  S427:='';
  4930.  for i:=2 to 7 do S427:=S427+IntToHex(GUID.D4[i],2);
  4931.  Result:=Format('{%s-%s-%s-%s-%s}', [S1, S2, S3, S401, S427]);
  4932. end;
  4933.  
  4934.  
  4935. function CreateGUID(out GUID: TGUID): HResult; stdcall;
  4936.  
  4937.  const
  4938.   Funcs: array[Boolean] of TString = ('UuidCreate', 'UuidCreateSequential');
  4939.  
  4940.  function DoCreate(Func: TString; out GUID: TGUID): HResult;
  4941.  var
  4942.   UuidCreateFunc : function (var guid: TGUID): LongInt stdcall;
  4943.   RPCRT4: HINST;
  4944.  begin
  4945.   RPCRT4:=LoadLibrary('RPCRT4.DLL');
  4946.   UuidCreateFunc:=GetProcAddress(RPCRT4, PChar(Func));
  4947.   Result:=UuidCreateFunc(GUID);
  4948.   FreeLibrary(RPCRT4);
  4949.  end;
  4950.  
  4951. begin
  4952.  Result:=DoCreate(Funcs[Win2K or WinME], GUID);
  4953. end;
  4954.  
  4955. const
  4956.  LTRS   : array [0..26] of Char = ' ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  4957.  
  4958. function LetterToNumber(const Letter: TString): Integer;
  4959. var
  4960.  Ch1, Ch2: Integer;
  4961.  L: Integer;
  4962. begin
  4963.  L:=GetLength(Letter);
  4964.  if Inside(L, 1, 2) then begin
  4965.   if Length(Letter)=1 then begin
  4966.    Ch1:=0; Ch2:=Ord(Letter[1])-64;
  4967.   end else begin
  4968.    Ch1:=Ord(Letter[1])-64; Ch2:=Ord(Letter[2])-64;
  4969.   end;
  4970.   Result:=Ch1*26+Ch2;
  4971.  end else Result:=-1;
  4972. end;
  4973.  
  4974. function NumberToLetter(Number: Integer): TString;
  4975. var
  4976.  C1, C2: Integer;
  4977. begin
  4978.  if Inside(Number, 1, 702) then begin
  4979.   C2:=Number mod 26;
  4980.   if C2 = 0 then C2:=26;
  4981.   C1:=(Number - C2) div 26;
  4982.   Result:=LeftTrim(LTRS[C1]+LTRS[C2]);
  4983.  end else Result:='';
  4984. end;
  4985.  
  4986. procedure SplitAlphanumericName(const Name: TString; var Alpha: TString;
  4987.  var Num: Integer; const AdditionalChars: TSetChar = []);
  4988. var
  4989.  _num: TString;
  4990.  i, Len, P, Code: Integer;
  4991.  Ch: Char;
  4992. begin
  4993.  Len:=Length(Name);
  4994.  P:=0;
  4995.  for i:=Len downto 1 do begin
  4996.   Ch:=Name[i];
  4997.   if IsCharAlpha(Ch) or (Ch in AdditionalChars) then begin
  4998.    P:=i;
  4999.    Break;
  5000.   end;
  5001.  end;
  5002.  if P = 0 then begin
  5003.   Alpha:=Name;
  5004.   Num:=0;
  5005.  end else begin
  5006.   Alpha:=Copy(Name, 1, P);
  5007.   _num:=Copy(Name, P+1, Len-P);
  5008.   val(_num, Num, Code);
  5009.  end;
  5010. end;
  5011.  
  5012. function HexToInt(const Hex: TString; var Code: Integer): Integer;
  5013. var
  5014.  I: Integer;
  5015.  C: Integer;
  5016.  N: Integer;
  5017.  Ch: Char;
  5018. begin
  5019.  Result:=0;
  5020.  Code:=0;
  5021.  C:=0;
  5022.  for i:=Length(Hex) downto 1 do begin
  5023.   Ch:=Hex[i];
  5024.   Hole(N);
  5025.   case Ch of
  5026.    '0'..'9': N:=Ord(Ch)-Ord('0');
  5027.    'A'..'F': N:=Ord(Ch)-Ord('A')+10;
  5028.    'a'..'f': N:=Ord(Ch)-Ord('a')+10;
  5029.    else begin
  5030.     Result:=0;
  5031.     Code:=i;
  5032.     Exit;
  5033.    end;
  5034.   end;
  5035.   N:=N shl C;
  5036.   Result:=Result or N;
  5037.   Inc(C, 4);
  5038.  end;
  5039. end;
  5040.  
  5041. function CreateInstance(CLSID, IID: TGUID; out Instance): HResult;
  5042. begin
  5043.  Result:=CoCreateInstance(CLSID, nil, CLSCTX_INPROC_SERVER, IID, Instance);
  5044.  if (Result <> S_OK) and Assigned(CannotCreateInstance) then CannotCreateInstance(CLSID);
  5045. end;
  5046.  
  5047. function Recycle(const Name: TString; Wnd: HWND = 0): Boolean;
  5048. var
  5049.  FileOp: TSHFileOpStruct;
  5050. begin
  5051.  ClearMem(FileOp, SizeOf(FileOp));
  5052.  if Wnd = 0 then Wnd := TrayWnd;
  5053.  FileOp.Wnd:=Wnd;
  5054.  FileOp.wFunc:=FO_DELETE;
  5055.  FileOp.pFrom:=PChar(Name);
  5056.  FileOp.fFlags:=FOF_ALLOWUNDO or FOF_NOERRORUI or FOF_SILENT;
  5057.  Result:=(SHFileOperation(FileOp) = 0) and (not FileOp.fAnyOperationsAborted);
  5058. end;
  5059.  
  5060. function MapNetworkDrive(Wnd: HWND = 0): DWORD;
  5061. begin
  5062.  if Wnd = 0 then Wnd:=TrayWnd;
  5063.  Result:=WNetConnectionDialog(Wnd, RESOURCETYPE_DISK);
  5064. end;
  5065.  
  5066. function DisconnectNetworkDrive(Wnd: HWND = 0): DWORD;
  5067. begin
  5068.  if Wnd = 0 then Wnd:=TrayWnd;
  5069.  Result:=WNetDisconnectDialog(Wnd, RESOURCETYPE_DISK);
  5070. end;
  5071.  
  5072. function BitsPerPixel: Integer;
  5073. var
  5074.  DH: HWND;
  5075.  DC: HDC;
  5076. begin
  5077.  DH:=GetDesktopWindow;
  5078.  DC:=GetDC(DH);
  5079.  Result:=GetDeviceCaps(DC, BITSPIXEL);
  5080.  ReleaseDC(DH, DC);
  5081. end;
  5082.  
  5083. function RegWriteStr(RootKey: HKEY; Key, Name, Value: TString): Boolean;
  5084. var
  5085.  Handle: HKEY;
  5086.  Res: LongInt;
  5087. begin
  5088.  Result:=False;
  5089.  Res:=RegCreateKeyEx(RootKey, PChar(Key), 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
  5090.   nil, Handle, nil);
  5091.  if Res<>ERROR_SUCCESS then Exit;
  5092.  Res:=RegSetValueEx(Handle, PChar(Name), 0, REG_SZ, PChar(Value), Length(Value)+1);
  5093.  Result:=Res=ERROR_SUCCESS;
  5094.  RegCloseKey(Handle);
  5095. end;
  5096.  
  5097. function RegQueryStr(RootKey: HKEY; Key, Name: TString; Success: PBoolean = nil): TString;
  5098. var
  5099.  Handle: HKEY;
  5100.  Res: LongInt;
  5101.  DataType, DataSize: DWORD;
  5102. begin
  5103.  SetByteValue(Success, Byte(False));
  5104.  Res:=RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_QUERY_VALUE, Handle);
  5105.  if Res<>ERROR_SUCCESS then Exit;
  5106.  Res:=RegQueryValueEx(Handle, PChar(Name), nil, @DataType, nil, @DataSize);
  5107.  if (Res<>ERROR_SUCCESS) or (DataType<>REG_SZ) then begin
  5108.   RegCloseKey(Handle);
  5109.   Exit;
  5110.  end;
  5111.  SetString(Result, nil, DataSize-1);
  5112.  Res:=RegQueryValueEx(Handle, PChar(Name), nil, @DataType, PByte(@Result[1]), @DataSize);
  5113.  if Res = ERROR_SUCCESS then SetByteValue(Success, Byte(True));
  5114.  RegCloseKey(Handle);
  5115. end;
  5116.  
  5117. function RunApplication(Path, CmdLine, Dir: TString; Wait: Boolean = False): Cardinal;
  5118. var
  5119.  StartUpInfo: TStartUpInfo;
  5120.  ProcessInformation: TProcessInformation;
  5121. begin
  5122.  FillChar(StartUpInfo, SizeOf(StartUpInfo), 0);
  5123.  FillChar(ProcessInformation, SizeOf(ProcessInformation), 0);
  5124.  CleanUp(Path, True);
  5125.  CleanUp(CmdLine, True);
  5126.  CleanUp(Dir, True);
  5127.  if IsEmptyStr(CmdLine) then CmdLine:=chSpace;
  5128.  Result:=0;
  5129.  if CreateProcess(PChar(Path), PChar(CmdLine), nil, nil, False, NORMAL_PRIORITY_CLASS,
  5130.   nil, PChar(Dir), StartUpInfo, ProcessInformation) then begin
  5131.   Result:=ProcessInformation.hProcess;
  5132.   if Wait then begin
  5133.    WaitForSingleObject(Result, INFINITE);
  5134.    Result:=1;
  5135.   end;
  5136.  end;
  5137. end;
  5138.  
  5139. procedure UniteLists(List1, List2: TStrings);
  5140. var
  5141.  C: Integer;
  5142.  i: Integer;
  5143.  S: TString;
  5144. begin
  5145.  C:=List2.Count-1;
  5146.  for i:=0 to C do begin
  5147.   S:=List2[i];
  5148.   if List1.IndexOf(S)=-1 then List1.Add(S);
  5149.  end;
  5150. end;
  5151.  
  5152.  
  5153. { TShellLink }
  5154.  
  5155. constructor TShellLink.Create;
  5156. begin
  5157.  inherited Create;
  5158.  OleInitialize(nil);
  5159.  CreateInstance(CLSID_ShellLink, IShellLink, FShellLink);
  5160.  if Assigned(FShellLink) then FShellLink.QueryInterface(IPersistFile, FPersistFile);
  5161. end;
  5162.  
  5163. function TShellLink.DesktopFolder: TString;
  5164. begin
  5165.  if IsEmptyStr(FDesktopFolder) then
  5166.   FDesktopFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_DESKTOP));
  5167.  Result:=FDesktopFolder;
  5168. end;
  5169.  
  5170. destructor TShellLink.Destroy;
  5171. begin
  5172.  FPersistFile:=nil;
  5173.  FShellLink:=nil;
  5174.  inherited Destroy;
  5175. end;
  5176.  
  5177. function TShellLink.GetArguments: TString;
  5178. var
  5179.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5180. begin
  5181.  Result:='';
  5182.  if Assigned(FShellLink) then begin
  5183.   FResult:=FShellLink.GetArguments(@Buf[0], MAX_PATH);
  5184.   RunError(SShellLinkReadError);
  5185.   Result:=PChar(@Buf[0]);
  5186.  end;
  5187. end;
  5188.  
  5189. function TShellLink.GetDescription: TString;
  5190. var
  5191.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5192. begin
  5193.  Result:='';
  5194.  if Assigned(FShellLink) then begin
  5195.   FResult:=FShellLink.GetDescription(@Buf[0], MAX_PATH);
  5196.   RunError(SShellLinkReadError);
  5197.   Result:=PChar(@Buf[0]);
  5198.  end;
  5199. end;
  5200.  
  5201. function TShellLink.GetHotKey: Word;
  5202. begin
  5203.  Result:=0;
  5204.  if Assigned(FShellLink) then begin
  5205.   FResult:=FShellLink.GetHotKey(Result);
  5206.   RunError(SShellLinkReadError);
  5207.  end;
  5208. end;
  5209.  
  5210. function TShellLink.GetIconIndex: Integer;
  5211. var
  5212.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5213. begin
  5214.  Result:=-1;
  5215.  if Assigned(FShellLink) then begin
  5216.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, Result);
  5217.   RunError(SShellLinkReadError);
  5218.  end;
  5219. end;
  5220.  
  5221. function TShellLink.GetIconLoc: TString;
  5222. var
  5223.  Dummy: Integer;
  5224.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5225. begin
  5226.  Result:='';
  5227.  if Assigned(FShellLink) then begin
  5228.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, Dummy);
  5229.   RunError(SShellLinkReadError);
  5230.   Result:=PChar(@Buf[0]);
  5231.  end;
  5232. end;
  5233.  
  5234. function TShellLink.GetPath: TString;
  5235. var
  5236.  Dummy: TWin32FindData;
  5237.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5238. begin
  5239.  Result:='';
  5240.  if Assigned(FShellLink) then begin
  5241.   FResult:=FShellLink.GetPath(@Buf[0], MAX_PATH, Dummy, SLGP_UNCPRIORITY);
  5242.   RunError(SShellLinkReadError);
  5243.   Result:=PChar(@Buf[0]);
  5244.  end;
  5245. end;
  5246.  
  5247. function TShellLink.GetPIDL: PItemIDList;
  5248. begin
  5249.  Result:=nil;
  5250.  if Assigned(FShellLink) then begin
  5251.   FResult:=FShellLink.GetIDList(Result);
  5252.   RunError(SShellLinkReadError);
  5253.  end;
  5254. end;
  5255.  
  5256. function TShellLink.GetShowCmd: Integer;
  5257. begin
  5258.  Result:=-1;
  5259.  if Assigned(FShellLink) then begin
  5260.   FResult:=FShellLink.GetShowCmd(Result);
  5261.   RunError(SShellLinkReadError);
  5262.  end;
  5263. end;
  5264.  
  5265. function TShellLink.GetWorkDir: TString;
  5266. var
  5267.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5268. begin
  5269.  Result:='';
  5270.  if Assigned(FShellLink) then begin
  5271.   FResult:=FShellLink.GetWorkingDirectory(@Buf[0], MAX_PATH);
  5272.   RunError(SShellLinkReadError);
  5273.   Result:=PChar(@Buf[0]);
  5274.  end;
  5275. end;
  5276.  
  5277. function TShellLink.LoadFromFile(FileName: TString): Boolean;
  5278. begin
  5279.  if Assigned(FPersistFile) then begin
  5280.   FResult:=FPersistFile.Load(ResolveFileName(FileName),  OF_READWRITE);
  5281.   RunError(SShellLinkLoadError, FileName);
  5282.  end;
  5283.  Result:=True;
  5284. end;
  5285.  
  5286. function TShellLink.MyDocsFolder: TString;
  5287. begin
  5288.  if IsEmptyStr(FMyDocsFolder) then
  5289.   FMyDocsFolder:=IncludeTrailingBackSlash(SpecialFolder(CSIDL_PERSONAL));
  5290.  Result:=FMyDocsFolder;
  5291. end;
  5292.  
  5293. function TShellLink.ProgramsFolder: TString;
  5294. begin
  5295.  if IsEmptyStr(FProgramsFolder) then
  5296.   FProgramsFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_PROGRAMS));
  5297.  Result:=FProgramsFolder;
  5298. end;
  5299.  
  5300.  
  5301. type
  5302.   TFuncStrObj = function: TString of object;
  5303.  
  5304. function TShellLink.ResolveFileName(FileName: TString): PWideChar;
  5305. var
  5306.  P: Integer;
  5307.  
  5308.  function Resolve(Str: TString; F: TFuncStrObj): Boolean;
  5309.  begin
  5310.   Result:=True;
  5311.   P:=Pos(Str, DnString(FileName));
  5312.   if P = 1 then begin
  5313.    Delete(FileName, 1, Length(Str));
  5314.    if FileName[1] = '\' then Delete(FileName, 1, 1);
  5315.    FileName:=F+FileName;
  5316.    Result:=False;
  5317.   end;
  5318.  end;
  5319.  
  5320. begin
  5321.  if Resolve('{$desktop}', DesktopFolder) then
  5322.  if Resolve('{$programs}', ProgramsFolder) then
  5323.  if Resolve('{$startmenu}', StartMenuFolder) then
  5324.  if Resolve('{$startup}', StartUpFolder) then Resolve('{$mydocs}', MyDocsFolder);
  5325.  FTemp:=FileName;
  5326.  Result:=PWideChar(@FTemp[1]);
  5327. end;
  5328.  
  5329. procedure TShellLink.RunError(const Msg, Args: TString);
  5330. begin
  5331.  if Failed(FResult) then begin
  5332.   FResult:=0;
  5333.   if Args<>'' then raise EShellLinkError.CreateFmt(Msg,[Args])
  5334.               else raise EShellLinkError.Create(Msg);
  5335.  end;
  5336. end;
  5337.  
  5338. function TShellLink.SaveToFile(FileName: TString): Boolean;
  5339. begin
  5340.  if Assigned(FPersistFile) then begin
  5341.   FResult:=FPersistFile.Save(ResolveFileName(FileName), True);
  5342.   RunError(SShellLinkSaveError, FileName);
  5343.  end;
  5344.  Result:=True;
  5345. end;
  5346.  
  5347. procedure TShellLink.SetArguments(const Value: TString);
  5348. begin
  5349.  if Assigned(FShellLink) then begin
  5350.   FResult:=FShellLink.SetArguments(PAnsiChar(Value));
  5351.   RunError(SShellLinkWriteError);
  5352.  end;
  5353. end;
  5354.  
  5355. procedure TShellLink.SetDescription(const Value: TString);
  5356. begin
  5357.  if Assigned(FShellLink) then begin
  5358.   FResult:=FShellLink.SetDescription(PAnsiChar(Value));
  5359.   RunError(SShellLinkWriteError);
  5360.  end;
  5361. end;
  5362.  
  5363. procedure TShellLink.SetHotKey(const Value: Word);
  5364. begin
  5365.  if Assigned(FShellLink) then begin
  5366.   FResult:=FShellLink.SetHotKey(Value);
  5367.   RunError(SShellLinkWriteError);
  5368.  end;
  5369. end;
  5370.  
  5371. procedure TShellLink.SetIconIndex(const Value: Integer);
  5372. var
  5373.  OldIndex:Integer;
  5374.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5375. begin
  5376.  if Assigned(FShellLink) then begin
  5377.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, OldIndex);
  5378.   RunError(SShellLinkWriteError);
  5379.   FResult:=FShellLink.SetIconLocation(@Buf[0], Value);
  5380.   RunError(SShellLinkWriteError);
  5381.  end;
  5382. end;
  5383.  
  5384. procedure TShellLink.SetIconLoc(const Value: TString);
  5385. var
  5386.  Index:Integer;
  5387.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5388. begin
  5389.  if Assigned(FShellLink) then begin
  5390.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, Index);
  5391.   RunError(SShellLinkWriteError);
  5392.   FResult:=FShellLink.SetIconLocation(PAnsiChar(Value),Index);
  5393.   RunError(SShellLinkWriteError);
  5394.  end;
  5395. end;
  5396.  
  5397. procedure TShellLink.SetPath(const Value: TString);
  5398. begin
  5399.  if Assigned(FShellLink) then begin
  5400.   FResult:=FShellLink.SetPath(PChar(Value));
  5401.   RunError(SShellLinkWriteError);
  5402.  end;
  5403. end;
  5404.  
  5405. procedure TShellLink.SetPIDL(const Value: PItemIDList);
  5406. begin
  5407.  if Assigned(FShellLink) then begin
  5408.   FResult:=FShellLink.SetIDList(Value);
  5409.   RunError(SShellLinkWriteError);
  5410.  end;
  5411. end;
  5412.  
  5413. procedure TShellLink.SetShowCmd(const Value: Integer);
  5414. begin
  5415.  if Assigned(FShellLink) then begin
  5416.   FResult:=FShellLink.SetShowCmd(Value);
  5417.   RunError(SShellLinkWriteError);
  5418.  end;
  5419. end;
  5420.  
  5421. procedure TShellLink.SetWorkDir(const Value: TString);
  5422. begin
  5423.  if Assigned(FShellLink) then begin
  5424.   FResult:=FShellLink.SetWorkingDirectory(PChar(Value));
  5425.   RunError(SShellLinkWriteError);
  5426.  end;
  5427. end;
  5428.  
  5429. class function TShellLink.SpecialFolder(FolderID: Integer): TString;
  5430. var
  5431.  PIDL:PItemIDList;
  5432.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5433. begin
  5434.  SHGetSpecialFolderLocation(0, FolderID, PIDL);
  5435.  SHGetPathFromIDList(PIDL, @Buf[0]);
  5436.  Result:=PChar(@Buf[0]);
  5437. end;
  5438.  
  5439. function TShellLink.StartMenuFolder: TString;
  5440. begin
  5441.  if IsEmptyStr(FStartMenuFolder) then
  5442.   FStartMenuFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_STARTMENU));
  5443.  Result:=FStartMenuFolder;
  5444. end;
  5445.  
  5446. function TShellLink.StartUpFolder: TString;
  5447. begin
  5448.  if IsEmptyStr(FStartUpFolder) then
  5449.   FStartUpFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_STARTUP));
  5450.  Result:=FStartUpFolder;
  5451. end;
  5452.  
  5453. { TDynamicArray }
  5454.  
  5455. function TDynamicArray.Add: Integer;
  5456. asm
  5457.    mov   edx, [eax].FCount
  5458.    push  edx
  5459.    call  TDynamicArray.Insert
  5460.    pop   eax
  5461. end;
  5462.  
  5463. function TDynamicArray.AddItem(const Item): Integer;
  5464. asm
  5465.    push  esi
  5466.    push  edi
  5467.    push  ebx
  5468.    mov   esi, eax
  5469.    mov   edi, edx
  5470.    call  TDynamicArray.Add
  5471.    mov   ebx, eax
  5472.    mov   edx, ebx
  5473.    mov   ecx, edi
  5474.    mov   eax, esi
  5475.    call  TDynamicArray.PutItem
  5476.    mov   eax, ebx
  5477.    pop   ebx
  5478.    pop   edi
  5479.    pop   esi
  5480. end;
  5481.  
  5482. function TDynamicArray.AllocMem(ACount: Cardinal; var Handle: hLocal): pointer;
  5483. asm
  5484.    push  edi
  5485.    mov   edi, ecx
  5486.    mov   eax, [eax].FItemSize
  5487.    imul  edx
  5488.    push  edi
  5489.    push  eax
  5490.    push  LHND
  5491.    call  LocalAlloc
  5492.    pop   edi
  5493.    mov   [edi], eax
  5494.    push  eax
  5495.    call  LocalLock
  5496.    pop   edi
  5497. end;
  5498.  
  5499. constructor TDynamicArray.Create(ACount, AItemSize: Cardinal);
  5500. begin
  5501.  inherited Create;
  5502.  FItemSize:=AItemSize;
  5503.  _SetCount(ACount);
  5504. end;
  5505.  
  5506. procedure TDynamicArray.Delete(Index: Integer);
  5507. var
  5508.    thx: LongInt;
  5509. asm
  5510.    mov   ecx, [eax].FCount
  5511.    test  ecx, ecx
  5512.    jz    @@10
  5513.    cmp   edx, ecx
  5514.    jge   @@10
  5515.    test  edx, edx
  5516.    jl    @@10
  5517.    push  esi
  5518.    push  edi
  5519.    push  ebx
  5520.    mov   esi, eax
  5521.    mov   ebx, edx
  5522.    mov   edx, [esi].FCount
  5523.    dec   edx
  5524.    lea   ecx, thx
  5525.    call  TDynamicArray.AllocMem
  5526.    mov   edi, eax
  5527.    mov   eax, [esi].FItemSize
  5528.    mov   ecx, ebx
  5529.    imul  ecx
  5530.    mov   ecx, eax
  5531.    mov   edx, edi
  5532.    mov   eax, [esi].FData
  5533.    call  MoveMem
  5534.    mov   eax, esi
  5535.    mov   edx, ebx
  5536.    inc   edx
  5537.    call  TDynamicArray.GetItemPtr
  5538.    push  eax
  5539.    mov   eax, [esi].FCount
  5540.    sub   eax, ebx
  5541.    dec   eax
  5542.    mov   edx, [esi].FItemSize
  5543.    push  edx
  5544.    imul  edx
  5545.    mov   ecx, eax
  5546.    mov   eax, ebx
  5547.    pop   edx
  5548.    imul  edx
  5549.    add   eax, edi
  5550.    mov   edx, eax
  5551.    pop   eax
  5552.    call  MoveMem
  5553.    mov   eax, esi
  5554.    lea   edx, [esi].FHandle
  5555.    call  TDynamicArray.FreeMem
  5556.    mov   [esi].FData, edi
  5557.    mov   eax, thx
  5558.    mov   [esi].FHandle, eax
  5559.    dec   dword ptr [esi].FCount
  5560.    mov   eax, esi
  5561.    call  TDynamicArray.DoSizeChanged
  5562.    pop   ebx
  5563.    pop   edi
  5564.    pop   esi
  5565.    jmp   @@20
  5566. @@10:
  5567.    call  TDynamicArray.Error
  5568. @@20:
  5569. end;
  5570.  
  5571. procedure TDynamicArray.DeleteItem(Index: Integer; out Item);
  5572. asm
  5573.    push   esi
  5574.    push   ebx
  5575.    mov    esi, eax
  5576.    mov    ebx, edx
  5577.    call   TDynamicArray.GetItem
  5578.    mov    eax, esi
  5579.    mov    edx, ebx
  5580.    call   TDynamicArray.Delete
  5581.    pop    ebx
  5582.    pop    esi
  5583. end;
  5584.  
  5585. destructor TDynamicArray.Destroy;
  5586. begin
  5587.  _SetCount(0);
  5588.  inherited;
  5589. end;
  5590.  
  5591. procedure TDynamicArray.DoSizeChanged;
  5592. begin
  5593.  SizeChanged;
  5594. end;
  5595.  
  5596. procedure TDynamicArray.Error(Index: Integer);
  5597. begin
  5598.   raise EDynArray.CreateFmt(SDynArrayIndexError,[ClassName, Index]);
  5599. end;
  5600.  
  5601. procedure TDynamicArray.Extend(Count: Cardinal);
  5602. asm
  5603.    add   edx, [eax].FCount
  5604.    call  TDynamicArray._SetCount
  5605. end;
  5606.  
  5607. function TDynamicArray.ForEach(Tag: Integer; ForEachFunc: TForEachFunc): Integer;
  5608. var
  5609.    _Tag: LongInt;
  5610.    _Size: LongInt;
  5611.    _Count: LongInt;
  5612. asm
  5613.    push  esi
  5614.    push  edi
  5615.    push  ebx
  5616.    mov   esi, [eax].FData
  5617.    mov   edi, ecx
  5618.    mov   ebx, [eax].FCount
  5619.    mov   ecx, [eax].FItemSize
  5620.    mov   _Size, ecx
  5621.    mov   _Tag,  edx
  5622.    mov   _Count, ebx
  5623.    sub   esi, _Size
  5624.    test  ebx, ebx
  5625. @@10:
  5626.    jle    @@20
  5627.    add   esi, _Size
  5628.    mov   eax, _Tag
  5629.    mov   edx, _Count
  5630.    sub   edx, ebx
  5631.    mov   ecx, esi
  5632.    call  edi
  5633.    test  eax, eax
  5634.    jnz   @@30
  5635.    dec   ebx
  5636.    jmp   @@10
  5637. @@20:
  5638.    xor   eax, eax
  5639. @@30:
  5640.    pop   ebx
  5641.    pop   edi
  5642.    pop   esi
  5643. end;
  5644.  
  5645. procedure TDynamicArray.FreeMem(var Handle: hLocal);
  5646. asm
  5647.    push  esi
  5648.    mov   esi, edx
  5649.    mov   eax, [esi]
  5650.    test  eax, eax
  5651.    jz    @@10
  5652.    push  eax
  5653.    push  eax
  5654.    call  LocalUnlock
  5655.    call  LocalFree
  5656.    xor   eax, eax
  5657.    mov   [esi], eax
  5658. @@10:
  5659.    pop   esi
  5660. end;
  5661.  
  5662. function TDynamicArray.GetFirstItem: Pointer;
  5663. asm
  5664.    mov   eax, [eax].FData
  5665. end;
  5666.  
  5667. procedure TDynamicArray.GetItem(Index: Integer; out Item);
  5668. asm
  5669.    push   esi
  5670.    push   edi
  5671.    push   ebx
  5672.    mov    esi, eax
  5673.    mov    edi, ecx
  5674.    mov    ebx, edx
  5675.    call   TDynamicArray.GetItemPtr
  5676.    test   eax, eax
  5677.    jnz    @@10
  5678.    mov    eax, esi
  5679.    mov    edx, ebx
  5680.    pop    ebx
  5681.    pop    edi
  5682.    pop    esi
  5683.    call   TDynamicArray.Error
  5684.    ret
  5685. @@10:
  5686.    mov    ecx, [esi].FItemSize
  5687.    mov    edx, edi
  5688.    call   MoveMem
  5689.    pop    ebx
  5690.    pop    edi
  5691.    pop    esi
  5692. end;
  5693.  
  5694. function TDynamicArray.GetItemPtr(Index: Integer): Pointer;
  5695. asm
  5696.    mov   ecx, [eax].FCount
  5697.    test  ecx, ecx
  5698.    jz    @@10
  5699.    test  edx, edx
  5700.    jl    @@10
  5701.    cmp   edx, ecx
  5702.    jge   @@10
  5703.    mov   ecx, [eax].FData
  5704.    mov   eax, [eax].FItemSize
  5705.    xchg  eax, edx
  5706.    imul  edx
  5707.    add   eax, ecx
  5708.    ret
  5709. @@10:
  5710.    xor   eax, eax
  5711. end;
  5712.  
  5713. procedure TDynamicArray.Insert(Index: Integer);
  5714. var
  5715.    thx: LongInt;
  5716. asm
  5717.    mov    ecx, [eax].FCount
  5718.    cmp    edx, ecx
  5719.    jg     @@10
  5720.    test   edx, edx
  5721.    jl     @@10
  5722.    push   esi
  5723.    push   edi
  5724.    push   ebx
  5725.    mov    esi, eax
  5726.    mov    ebx, edx
  5727.    mov    edx, [esi].FCount
  5728.    inc    edx
  5729.    lea    ecx, thx
  5730.    call   TDynamicArray.AllocMem
  5731.    mov    edi, eax
  5732.    mov    eax, [esi].FItemSize
  5733.    mov    ecx, ebx
  5734.    imul   ecx
  5735.    mov    ecx, eax
  5736.    mov    edx, edi
  5737.    mov    eax, [esi].FData
  5738.    call   MoveMem
  5739.    mov    eax, esi
  5740.    mov    edx, ebx
  5741.    call   TDynamicArray.GetItemPtr
  5742.    push   eax
  5743.    mov    eax, [esi].FCount
  5744.    sub    eax, ebx
  5745.    mov    edx, [esi].FItemSize
  5746.    push   edx
  5747.    imul   edx
  5748.    mov    ecx, eax
  5749.    mov    eax, ebx
  5750.    inc    eax
  5751.    pop    edx
  5752.    imul   edx
  5753.    add    eax, edi
  5754.    mov    edx, eax
  5755.    pop    eax
  5756.    call   MoveMem
  5757.    mov    eax, esi
  5758.    lea    edx, [esi].FHandle
  5759.    call   TDynamicArray.FreeMem
  5760.    mov    [esi].FData, edi
  5761.    mov    eax, thx
  5762.    mov    [esi].FHandle, eax
  5763.    inc    dword ptr [esi].FCount
  5764.    mov    eax, esi
  5765.    call   TDynamicArray.DoSizeChanged
  5766.    pop    ebx
  5767.    pop    edi
  5768.    pop    esi
  5769.    jmp    @@20
  5770. @@10:
  5771.    call   TDynamicArray.Error
  5772. @@20:
  5773. end;
  5774.  
  5775. procedure TDynamicArray.InsertItem(Index: Integer; const Item);
  5776. asm
  5777.    push   esi
  5778.    push   edi
  5779.    push   ebx
  5780.    mov    esi, eax
  5781.    mov    edi, ecx
  5782.    mov    ebx, edx
  5783.    call   TDynamicArray.Insert
  5784.    mov    eax, esi
  5785.    mov    ecx, edi
  5786.    mov    edx, ebx
  5787.    call   TDynamicArray.PutItem
  5788.    pop    ebx
  5789.    pop    edi
  5790.    pop    esi
  5791. end;
  5792.  
  5793. procedure TDynamicArray.PutItem(Index: Integer; const Item);
  5794. asm
  5795.    push   esi
  5796.    push   edi
  5797.    push   ebx
  5798.    mov    esi, eax
  5799.    mov    edi, ecx
  5800.    mov    ebx, edx
  5801.    call   TDynamicArray.GetItemPtr
  5802.    test   eax, eax
  5803.    jnz    @@10
  5804.    mov    eax, esi
  5805.    mov    edx, ebx
  5806.    pop    ebx
  5807.    pop    edi
  5808.    pop    esi
  5809.    call   TDynamicArray.Error
  5810.    ret
  5811. @@10:
  5812.    mov    ecx, [esi].FItemSize
  5813.    mov    edx, edi
  5814.    xchg   eax, edx
  5815.    call   MoveMem
  5816.    pop    ebx
  5817.    pop    edi
  5818.    pop    esi
  5819. end;
  5820.  
  5821. procedure TDynamicArray.SetCount(const Value: Cardinal);
  5822. var
  5823.  THX, TDX: LongInt;
  5824. asm
  5825.    test  edx, edx
  5826.    jg    @@10
  5827.    mov   [eax].FCount, 0
  5828.    lea   edx, [eax].FHandle
  5829.    call  TDynamicArray.FreeMem
  5830.    jmp   @@30
  5831. @@10:
  5832.    cmp   edx, [eax].FCount
  5833.    je    @@30
  5834.    push  esi
  5835.    push  edi
  5836.    mov   esi, eax
  5837.    mov   edi, edx
  5838.    lea   ecx, thx
  5839.    call  TDynamicArray.AllocMem
  5840.    mov   tdx, eax
  5841.    mov   ecx, [esi].FCount
  5842.    mov   edx, edi
  5843.    cmp   edx, ecx
  5844.    jl    @@20
  5845.    mov   edx, ecx
  5846. @@20:
  5847.    mov   eax, edx
  5848.    mov   edx, [esi].FItemSize
  5849.    imul  edx
  5850.    mov   ecx, eax
  5851.    mov   edx, tdx
  5852.    mov   eax, [esi].FData
  5853.    call  MoveMem
  5854.    mov   eax, tdx
  5855.    mov   [esi].FData, eax
  5856.    lea   edx, [esi].FHandle
  5857.    mov   eax, esi
  5858.    call  TDynamicArray.FreeMem
  5859.    mov   eax, thx
  5860.    mov   [esi].FHandle, eax
  5861.    mov   [esi].FCount, edi
  5862.    mov   eax, esi
  5863.    call  TDynamicArray.DoSizeChanged
  5864.    pop   edi
  5865.    pop   esi
  5866. @@30:
  5867. end;
  5868.  
  5869. procedure TDynamicArray.SizeChanged;
  5870. begin
  5871.  
  5872. end;
  5873.  
  5874. procedure TDynamicArray.Swap(Index1, Index2: Cardinal);
  5875. var
  5876.    thx, tdx: LongInt;
  5877. asm
  5878.    push  esi
  5879.    push  edi
  5880.    push  ebx
  5881.    mov   ebx, eax
  5882.    mov   esi, edx
  5883.    mov   edi, ecx
  5884.    mov   edx, 1
  5885.    lea   ecx, thx
  5886.    call  TDynamicArray.AllocMem
  5887.    mov   tdx, eax
  5888.    mov   eax, ebx
  5889.    mov   edx, esi
  5890.    call  TDynamicArray.GetItemPtr
  5891.    mov   edx, esi
  5892.    test  eax, eax
  5893.    jz    @@10
  5894.    mov   esi, eax
  5895.    mov   edx, tdx
  5896.    mov   ecx, [ebx].FItemSize
  5897.    call  MoveMem
  5898.    mov   eax, ebx
  5899.    mov   edx, edi
  5900.    call  TDynamicArray.GetItemPtr
  5901.    mov   edx, edi
  5902.    test  eax, eax
  5903.    jz    @@10
  5904.    mov   edi, eax
  5905.    mov   edx, esi
  5906.    mov   ecx, [ebx].FItemSize
  5907.    call  MoveMem
  5908.    mov   eax, tdx
  5909.    mov   edx, edi
  5910.    mov   ecx, [ebx].FItemSize
  5911.    call  MoveMem
  5912.    mov   eax, ebx
  5913.    lea   edx, thx
  5914.    call  TDynamicArray.FreeMem
  5915.    pop   ebx
  5916.    pop   edi
  5917.    pop   esi
  5918.    jmp   @@20
  5919. @@10:
  5920.    mov   eax, ebx
  5921.    push  eax
  5922.    push  edx
  5923.    lea   edx, thx
  5924.    call  TDynamicArray.FreeMem
  5925.    pop   edx
  5926.    pop   eax
  5927.    pop   ebx
  5928.    pop   edi
  5929.    pop   esi
  5930.    call  TDynamicArray.Error
  5931. @@20:
  5932. end;
  5933.  
  5934. procedure TDynamicArray.Trim(Count: Cardinal);
  5935. asm
  5936.    mov    ecx, edx
  5937.    mov    edx, [eax].FCount
  5938.    sub    edx, ecx
  5939.    call   TDynamicArray._SetCount
  5940. end;
  5941.  
  5942. procedure TDynamicArray._SetCount(const Value: Cardinal);
  5943. begin
  5944.  SetCount(Value);
  5945. end;
  5946.  
  5947. { TFile }
  5948.  
  5949. procedure TFile.Close;
  5950. begin
  5951.  Free;
  5952. end;
  5953.  
  5954. constructor TFile.Create(AFileName: TString; Backup: Boolean);
  5955. begin
  5956.  FStatus:=fsWriting;
  5957.  inherited Create;
  5958.  FFileName:=AFileName;
  5959.  if Backup and FileExists(FFileName) then CreateBackup;
  5960.  FHandle:=CreateFile(PChar(FFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
  5961.   FILE_ATTRIBUTE_NORMAL, 0);
  5962.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  5963. end;
  5964.  
  5965. procedure TFile.CreateBackup;
  5966. var
  5967.  BackupName: TString;
  5968.  Ext: TString;
  5969. begin
  5970.  BackupName:=FFileName;
  5971.  Ext:=ExtractFileExt(BackupName);
  5972.  BackupName:=TrailTrim(BackupName, Length(Ext));
  5973.  Delete(Ext, 1, 1);
  5974.  BackupName:=BackupName+'.~'+Ext;
  5975.  if FileExists(BackupName) then DeleteFile(BackupName);
  5976.  if not RenameFile(FFileName, BackupName) then Error(GetLastError)
  5977. end;
  5978.  
  5979. class function TFile.EncodeDateTime(Year, Month, Day, Hour, Min,
  5980.   Sec: Word): TFileTime;
  5981. var
  5982.  LT: TFileTime;
  5983.  ST: TSystemTime;
  5984. begin
  5985.  ST.wYear:=Year;
  5986.  ST.wMonth:=Month;
  5987.  ST.wDayOfWeek:=0;
  5988.  ST.wDay:=Day;
  5989.  ST.wHour:=Hour;
  5990.  ST.wMinute:=Min;
  5991.  ST.wSecond:=Sec;
  5992.  ST.wMilliseconds:=0;
  5993.  SystemTimeToFileTime(ST, LT);
  5994.  LocalFileTimeToFileTime(LT, Result);
  5995. end;
  5996.  
  5997. destructor TFile.Destroy;
  5998. begin
  5999.  CloseHandle(FHandle);
  6000.  inherited;
  6001. end;
  6002.  
  6003. procedure TFile.Error(Code: Integer);
  6004. const
  6005.  strFileStatus : array[TFileStatus] of TString = (SFileReading, SFileWriting);
  6006. begin
  6007.  if Code<>0 then raise EFileError.CreateFmt(SFileError,
  6008.   [strFileStatus[FStatus], FFileName, GetErrorMessage(Code)]);
  6009. end;
  6010.  
  6011. class procedure TFile.DecodeDateTime(const DateTime: TFileTime; Year,
  6012.   Month, Day, Hour, Min, Sec: PWord);
  6013. var
  6014.  LT: TFileTime;
  6015.  ST: TSystemTime;
  6016. begin
  6017.  FileTimeToLocalFileTime(DateTime, LT);
  6018.  FileTimeToSystemTime(LT, ST);
  6019.  SetWordValue(Year, ST.wYear);
  6020.  SetWordValue(Month, ST.wMonth);
  6021.  SetWordValue(Day, ST.wDay);
  6022.  SetWordValue(Hour, ST.wHour);
  6023.  SetWordValue(Min, ST.wMinute);
  6024.  SetWordValue(Sec, ST.wSecond);
  6025. end;
  6026.  
  6027. function TFile.GetAttributes: LongInt;
  6028. begin
  6029.  Result:=GetFileAttributes(PChar(FFileName));
  6030.  if Result = LongInt($FFFFFFFF) then Error(GetLastError);
  6031. end;
  6032.  
  6033. function TFile.GetCreationTime: TFileTime;
  6034. begin
  6035.  if not GetFileTime(FHandle, @Result, nil, nil) then Error(GetLastError);
  6036. end;
  6037.  
  6038. function TFile.GetErrorMessage(Code: Integer): TString;
  6039. begin
  6040.  case Code of
  6041.   2: Result:=SFileError002;
  6042.   3: Result:=SFileError003;
  6043.   4: Result:=SFileError004;
  6044.   5: Result:=SFileError005;
  6045.   14: Result:=SFileError014;
  6046.   15: Result:=SFileError015;
  6047.   17: Result:=SFileError017;
  6048.   19: Result:=SFileError019;
  6049.   20: Result:=SFileError020;
  6050.   21: Result:=SFileError021;
  6051.   22: Result:=SFileError022;
  6052.   25: Result:=SFileError025;
  6053.   26: Result:=SFileError026;
  6054.   27: Result:=SFileError027;
  6055.   29: Result:=SFileError029;
  6056.   30: Result:=SFileError030;
  6057.   32: Result:=SFileError032;
  6058.   36: Result:=SFileError036;
  6059.   38: Result:=SFileError038;
  6060.   39: Result:=SFileError039;
  6061.   50: Result:=SFileError050;
  6062.   51: Result:=SFileError051;
  6063.   52: Result:=SFileError052;
  6064.   53: Result:=SFileError053;
  6065.   54: Result:=SFileError054;
  6066.   55: Result:=SFileError055;
  6067.   57: Result:=SFileError057;
  6068.   58: Result:=SFileError058;
  6069.   59: Result:=SFileError059;
  6070.   64: Result:=SFileError064;
  6071.   65: Result:=SFileError065;
  6072.   66: Result:=SFileError066;
  6073.   67: Result:=SFileError067;
  6074.   70: Result:=SFileError070;
  6075.   82: Result:=SFileError082;
  6076.   112: Result:=SFileError112;
  6077.   123: Result:=SFileError123;
  6078.   161: Result:=SFileError161;
  6079.   183: Result:=SFileError183;
  6080.   else Result:='';
  6081.  end;
  6082. end;
  6083.  
  6084. function TFile.GetLastAccessTime: TFileTime;
  6085. begin
  6086.  if not GetFileTime(FHandle, nil, @Result, nil) then Error(GetLastError);
  6087. end;
  6088.  
  6089. function TFile.GetLastWriteTime: TFileTime;
  6090. begin
  6091.  if not GetFileTime(FHandle, nil, nil, @Result) then Error(GetLastError);
  6092. end;
  6093.  
  6094. function TFile.GetSize: Integer;
  6095. begin
  6096.  Result:=GetFileSize(FHandle, nil);
  6097.  if Result = -1 then Error(GetLastError);
  6098. end;
  6099.  
  6100. constructor TFile.Open(AFileName: TString);
  6101. begin
  6102.  inherited Create;
  6103.  FStatus:=fsReading;
  6104.  FFileName:=AFileName;
  6105.  FHandle:=CreateFile(PChar(FFileName), GENERIC_READ, 0, nil, OPEN_EXISTING,
  6106.   FILE_ATTRIBUTE_NORMAL, 0);
  6107.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6108. end;
  6109.  
  6110. procedure TFile.Read(var Buffer; Size: Integer);
  6111. begin
  6112.  if FStatus = fsReading then begin
  6113.   if not ReadFile(FHandle, Buffer, Cardinal(Size), FDummy, nil)
  6114.    then Error(GetLastError);
  6115.  end;
  6116. end;
  6117.  
  6118. procedure TFile.Seek(Position: Integer);
  6119. begin
  6120.  SetFilePointer(FHandle, Position, nil, FILE_BEGIN);
  6121.  Error(GetLastError);
  6122. end;
  6123.  
  6124. procedure TFile.SetAttributes(const Value: LongInt);
  6125. begin
  6126.  if not SetFileAttributes(PChar(FFileName), Value) then Error(GetLastError);
  6127. end;
  6128.  
  6129. procedure TFile.SetCreationTime(const Value: TFileTime);
  6130. begin
  6131.  if not SetFileTime(FHandle, @Value, nil, nil) then Error(GetLastError);
  6132. end;
  6133.  
  6134. procedure TFile.SetLastAccessTime(const Value: TFileTime);
  6135. begin
  6136.  if not SetFileTime(FHandle, nil, @Value, nil) then Error(GetLastError);
  6137. end;
  6138.  
  6139. procedure TFile.SetLastWriteTime(const Value: TFileTime);
  6140. begin
  6141.  if not SetFileTime(FHandle, nil, nil, @Value) then Error(GetLastError);
  6142. end;
  6143.  
  6144. procedure TFile.UserError(Code: Integer);
  6145. begin
  6146.  Error(Code);
  6147. end;
  6148.  
  6149. procedure TFile.Write(const Buffer; Size: Integer);
  6150. begin
  6151.  if FStatus = fsWriting then begin
  6152.   if not WriteFile(FHandle, Buffer, Cardinal(Size), FDummy, nil)
  6153.    then Error(GetLastError);
  6154.  end;
  6155. end;
  6156.  
  6157. { TFileStrm }
  6158.  
  6159. procedure TFileStrm.Close;
  6160. begin
  6161.  Free;
  6162. end;
  6163.  
  6164. constructor TFileStrm.Create(AFileName: TString; Backup: Boolean);
  6165. begin
  6166.  FStatus:=fsWriting;
  6167.  inherited Create;
  6168.  FFileName:=AFileName;
  6169.  if Backup and FileExists(FFileName) then CreateBackup;
  6170.  FHandle:=CreateFile(PChar(FFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
  6171.   FILE_ATTRIBUTE_NORMAL, 0);
  6172.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6173. end;
  6174.  
  6175. procedure TFileStrm.CreateBackup;
  6176. var
  6177.  BackupName: TString;
  6178.  Ext: TString;
  6179. begin
  6180.  BackupName:=FFileName;
  6181.  Ext:=ExtractFileExt(BackupName);
  6182.  BackupName:=TrailTrim(BackupName, Length(Ext));
  6183.  Delete(Ext, 1, 1);
  6184.  BackupName:=BackupName+'.~'+Ext;
  6185.  if FileExists(BackupName) then DeleteFile(BackupName);
  6186.  if not RenameFile(FFileName, BackupName) then Error(GetLastError)
  6187. end;
  6188.  
  6189. class procedure TFileStrm.DecodeDateTime(const DateTime: TFileTime; Year,
  6190.   Month, Day, Hour, Min, Sec: PWord);
  6191. var
  6192.  LT: TFileTime;
  6193.  ST: TSystemTime;
  6194. begin
  6195.  FileTimeToLocalFileTime(DateTime, LT);
  6196.  FileTimeToSystemTime(LT, ST);
  6197.  SetWordValue(Year, ST.wYear);
  6198.  SetWordValue(Month, ST.wMonth);
  6199.  SetWordValue(Day, ST.wDay);
  6200.  SetWordValue(Hour, ST.wHour);
  6201.  SetWordValue(Min, ST.wMinute);
  6202.  SetWordValue(Sec, ST.wSecond);
  6203. end;
  6204.  
  6205. destructor TFileStrm.Destroy;
  6206. begin
  6207.  CloseHandle(FHandle);
  6208.  inherited;
  6209. end;
  6210.  
  6211. class function TFileStrm.EncodeDateTime(Year, Month, Day, Hout, Min,
  6212.   Sec: Word): TFileTime;
  6213. var
  6214.  LT: TFileTime;
  6215.  ST: TSystemTime;
  6216. begin
  6217.  ST.wYear:=Year;
  6218.  ST.wMonth:=Month;
  6219.  ST.wDayOfWeek:=0;
  6220.  ST.wDay:=Day;
  6221.  ST.wHour:=Hour;
  6222.  ST.wMinute:=Min;
  6223.  ST.wSecond:=Sec;
  6224.  ST.wMilliseconds:=0;
  6225.  SystemTimeToFileTime(ST, LT);
  6226.  LocalFileTimeToFileTime(LT, Result);
  6227. end;
  6228.  
  6229. procedure TFileStrm.Error(Code: Integer);
  6230. const
  6231.  strFileStatus : array[TFileStatus] of TString = (SFileReading, SFileWriting);
  6232. begin
  6233.  if Code<>0 then raise EFileError.CreateFmt(SFileError,
  6234.   [strFileStatus[FStatus], FFileName, GetErrorMessage(Code)]);
  6235. end;
  6236.  
  6237. function TFileStrm.GetAttributes: LongInt;
  6238. begin
  6239.  Result:=GetFileAttributes(PChar(FFileName));
  6240.  if Result = LongInt($FFFFFFFF) then Error(GetLastError);
  6241. end;
  6242.  
  6243. function TFileStrm.GetCreationTime: TFileTime;
  6244. begin
  6245.  if not GetFileTime(FHandle, @Result, nil, nil) then Error(GetLastError);
  6246. end;
  6247.  
  6248. function TFileStrm.GetErrorMessage(Code: Integer): TString;
  6249. begin
  6250.  case Code of
  6251.   2: Result:=SFileError002;
  6252.   3: Result:=SFileError003;
  6253.   4: Result:=SFileError004;
  6254.   5: Result:=SFileError005;
  6255.   14: Result:=SFileError014;
  6256.   15: Result:=SFileError015;
  6257.   17: Result:=SFileError017;
  6258.   19: Result:=SFileError019;
  6259.   20: Result:=SFileError020;
  6260.   21: Result:=SFileError021;
  6261.   22: Result:=SFileError022;
  6262.   25: Result:=SFileError025;
  6263.   26: Result:=SFileError026;
  6264.   27: Result:=SFileError027;
  6265.   29: Result:=SFileError029;
  6266.   30: Result:=SFileError030;
  6267.   32: Result:=SFileError032;
  6268.   36: Result:=SFileError036;
  6269.   38: Result:=SFileError038;
  6270.   39: Result:=SFileError039;
  6271.   50: Result:=SFileError050;
  6272.   51: Result:=SFileError051;
  6273.   52: Result:=SFileError052;
  6274.   53: Result:=SFileError053;
  6275.   54: Result:=SFileError054;
  6276.   55: Result:=SFileError055;
  6277.   57: Result:=SFileError057;
  6278.   58: Result:=SFileError058;
  6279.   59: Result:=SFileError059;
  6280.   64: Result:=SFileError064;
  6281.   65: Result:=SFileError065;
  6282.   66: Result:=SFileError066;
  6283.   67: Result:=SFileError067;
  6284.   70: Result:=SFileError070;
  6285.   82: Result:=SFileError082;
  6286.   112: Result:=SFileError112;
  6287.   123: Result:=SFileError123;
  6288.   161: Result:=SFileError161;
  6289.   183: Result:=SFileError183;
  6290.   else Result:='';
  6291.  end;
  6292. end;
  6293.  
  6294. function TFileStrm.GetLastAccessTime: TFileTime;
  6295. begin
  6296.  if not GetFileTime(FHandle, nil, @Result, nil) then Error(GetLastError);
  6297. end;
  6298.  
  6299. function TFileStrm.GetLastWriteTime: TFileTime;
  6300. begin
  6301.  if not GetFileTime(FHandle, nil, nil, @Result) then Error(GetLastError);
  6302. end;
  6303.  
  6304. constructor TFileStrm.Open(AFileName: TString);
  6305. begin
  6306.  inherited Create;
  6307.  FStatus:=fsReading;
  6308.  FFileName:=AFileName;
  6309.  FHandle:=CreateFile(PChar(FFileName), GENERIC_READ, 0, nil, OPEN_EXISTING,
  6310.   FILE_ATTRIBUTE_NORMAL, 0);
  6311.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6312. end;
  6313.  
  6314. function TFileStrm.Read(var Buffer; Count: Integer): LongInt;
  6315. begin
  6316.  if FStatus = fsReading then begin
  6317.   if not ReadFile(FHandle, Buffer, Cardinal(Count), LongWord(Result), nil)
  6318.    then Error(GetLastError);
  6319.  end;
  6320. end;
  6321.  
  6322. function TFileStrm.Seek(Offset: Integer; Origin: Word): LongInt;
  6323. begin
  6324.  Result:=SetFilePointer(FHandle, Position, nil, Origin);
  6325.  Error(GetLastError);
  6326. end;
  6327.  
  6328. procedure TFileStrm.SetAttributes(const Value: LongInt);
  6329. begin
  6330.  if not SetFileAttributes(PChar(FFileName), Value) then Error(GetLastError);
  6331. end;
  6332.  
  6333. procedure TFileStrm.SetCreationTime(const Value: TFileTime);
  6334. begin
  6335.  if not SetFileTime(FHandle, @Value, nil, nil) then Error(GetLastError);
  6336. end;
  6337.  
  6338. procedure TFileStrm.SetLastAccessTime(const Value: TFileTime);
  6339. begin
  6340.  if not SetFileTime(FHandle, nil, @Value, nil) then Error(GetLastError);
  6341. end;
  6342.  
  6343. procedure TFileStrm.SetLastWriteTime(const Value: TFileTime);
  6344. begin
  6345.  if not SetFileTime(FHandle, nil, nil, @Value) then Error(GetLastError);
  6346. end;
  6347.  
  6348. procedure TFileStrm.SetSize(NewSize: LongInt);
  6349. begin
  6350.  raise EFileError.Create(SCannotSetSize);
  6351. end;
  6352.  
  6353. procedure TFileStrm.UserError(Code: Integer);
  6354. begin
  6355.  Error(Code);
  6356. end;
  6357.  
  6358. function TFileStrm.Write(const Buffer; Count: Integer): LongInt;
  6359. begin
  6360.  if FStatus = fsWriting then begin
  6361.   if not WriteFile(FHandle, Buffer, Cardinal(Count), LongWord(Result), nil)
  6362.    then Error(GetLastError);
  6363.  end;
  6364. end;
  6365.  
  6366. { TUnknown }
  6367.  
  6368. function TUnknown.QueryInterface(const IID: TGUID; out Obj): HResult;
  6369. begin
  6370.  if GetInterface(IID, Obj) then Result:=S_OK else Result:=E_NOINTERFACE;
  6371. end;
  6372.  
  6373. function TUnknown.Unknown: IUnknown;
  6374. begin
  6375.  GetInterface(IUnknown, Result);
  6376. end;
  6377.  
  6378. procedure TUnknown.Unknown(out Obj);
  6379. begin
  6380.  GetInterface(IUnknown, Obj);
  6381. end;
  6382.  
  6383. function TUnknown._AddRef: Integer;
  6384. begin
  6385.  Result:=Incr(FRefCount);
  6386. end;
  6387.  
  6388. function TUnknown._Release: Integer;
  6389. begin
  6390.  Result:=Decr(FRefCount);
  6391. end;
  6392.  
  6393. { TMatrixRow }
  6394.  
  6395. constructor TMatrixRow.Create(AColCount: Integer; AMatrix: TMatrix);
  6396. begin
  6397.  FMatrix:=AMatrix;
  6398.  inherited Create(AColCount, FMatrix.FItemSize);
  6399. end;
  6400.  
  6401. { TMatrixRows }
  6402.  
  6403. constructor TMatrixRows.Create(AMatrix: TMatrix);
  6404. begin
  6405.  inherited Create(0, SizeOf(TMatrixRow));
  6406. end;
  6407.  
  6408. procedure TMatrixRows.DeleteCol(Index: Integer);
  6409. begin
  6410.  FColIndex:=Index;
  6411.  ForEach(Integer(Self), @TMatrixRows.DeleteColFunc);
  6412.  Dec(FWidth);
  6413. end;
  6414.  
  6415. function TMatrixRows.DeleteColFunc(Index: Integer;
  6416.   var Row: TMatrixRow): Integer;
  6417. begin
  6418.  Row.Delete(FColIndex);
  6419.  Result:=0;
  6420. end;
  6421.  
  6422. function TMatrixRows.GetRow(Index: Integer): TMatrixRow;
  6423. begin
  6424.  Result:=PMatrixRow(GetItemPtr(Index))^;
  6425. end;
  6426.  
  6427. procedure TMatrixRows.InsertCol(Index: Integer);
  6428. begin
  6429.  FColIndex:=Index;
  6430.  ForEach(Integer(Self), @TMatrixRows.InsertColFunc);
  6431.  Inc(FWidth);
  6432. end;
  6433.  
  6434. function TMatrixRows.InsertColFunc(Index: Integer;
  6435.   var Row: TMatrixRow): Integer;
  6436. begin
  6437.  Row.Insert(FColIndex);
  6438.  Result:=0;
  6439. end;
  6440.  
  6441. procedure TMatrixRows.SetRow(Index: Integer; const Value: TMatrixRow);
  6442. begin
  6443.  PMatrixRow(GetItemPtr(Index))^:=Value;
  6444. end;
  6445.  
  6446. procedure TMatrixRows.SetWidth(const Value: Integer);
  6447. begin
  6448.  FWidth := Value;
  6449.  ForEach(Integer(Self), @TMatrixRows.SetWidthFunc);
  6450. end;
  6451.  
  6452. function TMatrixRows.SetWidthFunc(Index: Integer;
  6453.   var Row: TMatrixRow): Integer;
  6454. begin
  6455.  Row.Count:=FWidth;
  6456.  Result:=0;
  6457. end;
  6458.  
  6459. { TMatrix }
  6460.  
  6461. constructor TMatrix.Create(AColCount, ARowCount, AItemSize: Integer);
  6462. begin
  6463.  inherited Create;
  6464.  FItemSize:=AItemSize;
  6465.  FRows:=TMatrixRows.Create(Self);
  6466.  RowCount:=ARowCount;
  6467.  ColCount:=AColCount;
  6468. end;
  6469.  
  6470. function TMatrix.CreateRow: TMatrixRow;
  6471. begin
  6472.  Result:=TMatrixRow.Create(ColCount, Self);
  6473. end;
  6474.  
  6475. procedure TMatrix.DeleteCol(Index: Integer);
  6476. begin
  6477.  if Inside(Index, 0, FRows.Width - 1)
  6478.   then FRows.DeleteCol(Index)
  6479.   else raise EMatrixError.CreateFmt(SColIndexOutOfRange, [Index]);
  6480. end;
  6481.  
  6482. procedure TMatrix.DeleteRow(Index: Integer);
  6483. begin
  6484.  if Inside(Index, 0, FRows.Count - 1) then begin
  6485.   FRows[Index].Free;
  6486.   FRows.Delete(Index);
  6487.  end else raise EMatrixError.CreateFmt(SRowIndexOutOfRange, [Index]);
  6488. end;
  6489.  
  6490. destructor TMatrix.Destroy;
  6491. begin
  6492.  FRows.Free;
  6493.  inherited;
  6494. end;
  6495.  
  6496. function TMatrix.ForEachRow(Tag: Integer;
  6497.   ForEachRowFunc: TForEachFunc): Integer;
  6498. begin
  6499.  Result:=FRows.ForEach(Tag, ForEachRowFunc);
  6500. end;
  6501.  
  6502. function TMatrix.GetColCount: Integer;
  6503. begin
  6504.  Result:=FRows.Width;
  6505. end;
  6506.  
  6507. procedure TMatrix.GetItem(ACol, ARow: Integer; out Item);
  6508. begin
  6509.  if Inside(ARow, 0, FRows.Count - 1) and Inside(ACol, 0, FRows.FWidth-1)
  6510.   then FRows[ARow].GetItem(ACol, Item)
  6511.   else raise EMatrixError.CreateFmt(SIndicesOutOfRange, [ACol, ARow]);
  6512. end;
  6513.  
  6514. function TMatrix.GetRow(Index: Integer): TMatrixRow;
  6515. begin
  6516.  Result:=FRows[Index];
  6517. end;
  6518.  
  6519. function TMatrix.GetRowCount: Integer;
  6520. begin
  6521.  Result:=FRows.Count;
  6522. end;
  6523.  
  6524. procedure TMatrix.InsertCol(Index: Integer);
  6525. begin
  6526.  if Inside(Index, 0, FRows.Width)
  6527.   then FRows.InsertCol(Index)
  6528.   else raise EMatrixError.CreateFmt(SColIndexOutOfRange, [Index]);
  6529. end;
  6530.  
  6531. procedure TMatrix.InsertRow(Index: Integer);
  6532. var
  6533.  Temp: TMatrixRow;
  6534. begin
  6535.  if Inside(Index, 0, FRows.Count) then begin
  6536.   Temp:=CreateRow;
  6537.   FRows.InsertItem(Index, Temp);
  6538.  end else raise EMatrixError.CreateFmt(SRowIndexOutOfRange, [Index]);
  6539. end;
  6540.  
  6541. procedure TMatrix.PutItem(ACol, ARow: Integer; const Item);
  6542. begin
  6543.  if Inside(ARow, 0, FRows.Count - 1) and Inside(ACol, 0, FRows.FWidth-1)
  6544.   then FRows[ARow].PutItem(ACol, Item)
  6545.   else raise EMatrixError.CreateFmt(SIndicesOutOfRange, [ACol, ARow]);
  6546. end;
  6547.  
  6548. procedure TMatrix.SetColCount(const Value: Integer);
  6549. begin
  6550.  FRows.Width:=Value;
  6551. end;
  6552.  
  6553. procedure TMatrix.SetRowCount(const Value: Integer);
  6554. var
  6555.  OldCount: Integer;
  6556.  i: Integer;
  6557. begin
  6558.  OldCount:=RowCount;
  6559.  if OldCount < Value then begin
  6560.   for i:=OldCount+1 to Value do InsertRow(RowCount);
  6561.  end else if OldCount > Value then begin
  6562.   for i:=OldCount-1 downto Value do DeleteRow(RowCount-1);
  6563.  end;
  6564. end;
  6565.  
  6566. end.
  6567.  
  6568.